Re: [frogs] chord-name-engraver plus capo - schemeing away ...

[Neil Puttock <n.puttock@xxxxxxxxx>]

On 27 August 2010 23:59, Wols Lists <antlists@xxxxxxxxxxxxxxx> wrote:

> If I shouldn't be doing it in C++, where on earth do I start doing it in
> Scheme?

See the attached patch for a first draft (missing the conversion of
capoFret to a transposition pitch).

Cheers,
Neil

From 2128486a9ac4d7fd9fcad6522d24e4dd3c0d9947 Mon Sep 17 00:00:00 2001
From: Neil Puttock <n.puttock@xxxxxxxxx>
Date: Sat, 28 Aug 2010 20:44:47 +0100
Subject: [PATCH] chord and capo in scheme

---
 scm/chord-generic-names.scm  |    5 ++++-
 scm/chord-ignatzek-names.scm |    6 ++++++
 scm/chord-name.scm           |   26 ++++++++++++++++++++++++++
 3 files changed, 36 insertions(+), 1 deletions(-)

diff --git a/scm/chord-generic-names.scm b/scm/chord-generic-names.scm
index aa62089..e6ff848 100644
--- a/scm/chord-generic-names.scm
+++ b/scm/chord-generic-names.scm
@@ -37,11 +37,14 @@
 	     markup))
       markup))
 
+(define-public (jazz-chord-names pitches bass inversion context)
+  (capo-handler jazz-chord-names-internal pitches bass inversion context))
+
 (define-public (banter-chord-names pitches bass inversion context)
   (ugh-compat-double-plus-new-chord->markup
    'banter pitches bass inversion context '()))
 
-(define-public (jazz-chord-names pitches bass inversion context)
+(define (jazz-chord-names-internal pitches bass inversion context)
   (ugh-compat-double-plus-new-chord->markup
    'jazz pitches bass inversion context '()))
 
diff --git a/scm/chord-ignatzek-names.scm b/scm/chord-ignatzek-names.scm
index 0f6cc9c..5f6ad5f 100644
--- a/scm/chord-ignatzek-names.scm
+++ b/scm/chord-ignatzek-names.scm
@@ -69,6 +69,12 @@
 (define-public (ignatzek-chord-names
 		in-pitches bass inversion
 		context)
+  (capo-handler ignatzek-chord-names-internal
+		in-pitches bass inversion context))
+
+(define (ignatzek-chord-names-internal
+	 in-pitches bass inversion
+	 context)
 
   (define (remove-uptil-step x ps)
     "Copy PS, but leave out everything below the Xth step."
diff --git a/scm/chord-name.scm b/scm/chord-name.scm
index 7f5909b..4ecc643 100644
--- a/scm/chord-name.scm
+++ b/scm/chord-name.scm
@@ -169,3 +169,29 @@ FOOBAR-MARKUP) if OMIT-ROOT is given and non-false.
 	 (alist (map chord-to-exception-entry elts)))
     (filter (lambda (x) (cdr x)) alist)))
 
+(define (capo-handler chord-function pitches bass inversion context)
+  (let* ((main (chord-function pitches bass inversion context))
+	 (capo (ly:context-property context 'capoFret #f))
+	 (capo-markup (and capo
+			   (let* (;; do pitch calculation here based
+				  ;; on capoFret setting
+				  (capo-pitch (ly:make-pitch -1 5 0))
+				  (new-pitches
+				   (map (lambda (p)
+					  (ly:pitch-transpose p capo-pitch))
+					pitches))
+				  (new-bass
+				   (and (ly:pitch? bass)
+					(ly:pitch-transpose bass capo-pitch)))
+				  (new-inversion
+				   (and (ly:pitch? inversion)
+					(ly:pitch-transpose inversion
+							    capo-pitch))))
+			     (make-parenthesize-markup
+			      (chord-function new-pitches new-bass new-inversion
+					      context))))))
+
+    (if capo-markup
+	(make-line-markup (list main (make-hspace-markup 1) capo-markup))
+	;;(make-column-markup (list main capo-markup))
+	main)))
-- 
1.7.0.4