* lily/context-def.cc (filter_performers): don't go to cdrloc if

	skipping last pair. Fixes: crash-bar-number.

	* scm/fret-diagrams.scm (nil): fret-diagrams (courtesy Carl
	D. Sorensen)

	* input/test/fret-diagram.ly: new file.

	* scm/paper.scm (paper-set-staff-size): scale linewidth too.
	(scale-paper): divide by scale.

diff --git a/ChangeLog b/ChangeLog
index dbcdcba2c07e3c9fc42219e243b8a7032fbaf6f8..c6881cb685fab5f30267e618fd98071dffafed8a 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,13 @@
 2004-05-24  Han-Wen Nienhuys   <hanwen@xs4all.nl>
 
+       * lily/context-def.cc (filter_performers): don't go to cdrloc if
+       skipping last pair. Fixes: crash-bar-number.
+
+       * scm/fret-diagrams.scm (nil): fret-diagrams (courtesy Carl
+       D. Sorensen)
+
+       * input/test/fret-diagram.ly: new file.
+
        * scm/paper.scm (paper-set-staff-size): scale linewidth too.
        (scale-paper): divide by scale.
 

diff --git a/Documentation/topdocs/NEWS.texi b/Documentation/topdocs/NEWS.texi
index 7959ff7054ca8a83772703ed95efb015c5e8b8ea..2593e4ea2e18683188b0df51e92b232d641cdb1d 100644 (file)
--- a/Documentation/topdocs/NEWS.texi
+++ b/Documentation/topdocs/NEWS.texi
@@ -7,6 +7,10 @@
 @unnumbered New features in 2.3 since 2.2
 
 @itemize @bullet
+
+@item Support for fret diagrams  has been contributed by Carl
+D. Sorensen. @file{input/test/fret-diagram.ly} contains an example.
+ 
 @item The @code{--safe} mode has been revisited: it makes the basic
 ly: interface available, and stops malicious @TeX{} code.
 

diff --git a/THANKS b/THANKS
index dd310a2f33d6d5ee3a3fe68fa23dbd970a0d100a..c3aa719cfe70223baecdeaf72e70ca21f83c1195 100644 (file)
--- a/THANKS
+++ b/THANKS
@@ -10,6 +10,7 @@ Jan Nieuwenhuizen
 
 CONTRIBUTORS
 
+Carl Sorensen
 Michael Welsh Duggan
 Pedro Kroger
 Erik Sandberg

diff --git a/input/test/fret-diagram.ly b/input/test/fret-diagram.ly
new file mode 100644 (file)
index 0000000..38243e9
--- /dev/null
+++ b/input/test/fret-diagram.ly
@@ -0,0 +1,26 @@
+\header
+{
+  texidoc = "Frets are supported as markup commands."
+}
+
+\version "2.3.1"
+
+\score {
+    <<
+       \new ChordNames \chords {c2. f d s bes}
+       
+    \notes \context Voice=mel {
+%    c'2. c' c' c' c'
+        c'2.^\markup \override #'(staff-padding . 4.0) {\fret-diagram #1 #"f:2;6-x;5-3-3;4-2-2;3-o;2-1-1;1-o;"}
+        f'^\markup {\fret-diagram #1 #"c:6-1-1;p:0.5;6-1;5-3;4-3;3-2;2-1;1-1;"}
+        d' ^\markup \fret-diagram #1 #"f:1;6-x;5-x;4-o;3-2-1;2-3-3;1-2-2;"
+        d' ^\markup \fret-diagram #.75 #"f:1;6-x;5-x;4-o;3-2-1;2-3-3;1-2-2;"
+        bes' ^\markup \fret-diagram #1.5 #"6-1;5-1;4-3;3-3;2-3;1-1;c:6-1-1;c:2-4-3;"
+        bes'
+        a'2.^\markup \fret-diagram #1 #"6-x;5-x;4-o;3-14;2-13;1-12;"
+        c''
+        bes'2.^\markup \fret-diagram #1 #"6-1;5-1;4-3;3-3;2-3;1-1;c:6-1-1;c:2-4-3;"
+    }
+    >>
+  \paper{ raggedright = ##t }
+}

diff --git a/lily/book-paper-def.cc b/lily/book-paper-def.cc
index 1c4d048d6f147b624fd2ac3596ec3897254878ac..f67aad213113897ad4b6061ea1d82bbf9f81613f 100644 (file)
--- a/lily/book-paper-def.cc
+++ b/lily/book-paper-def.cc
@@ -31,12 +31,15 @@ Book_paper_def::Book_paper_def ()
 
 Book_paper_def::Book_paper_def (Book_paper_def const & src)
 {
+  output_scale_ = src.output_scale_;
   scope_ = SCM_EOL;
   scaled_fonts_ = SCM_EOL;
   smobify_self ();
   scope_= ly_make_anonymous_module (false);
   if (is_module (src.scope_))
     ly_import_module (scope_, src.scope_);
+
+  scaled_fonts_ = scm_c_make_hash_table (11); // copying is not done with live defs. hopefully.
 }
 
 Book_paper_def::~Book_paper_def ()

diff --git a/lily/book.cc b/lily/book.cc
index 4e804b7d52ee90e381df8336fb9de8ec0d655bcb..8ff6521d7753033f27023653ddba423553e2a7d0 100644 (file)
--- a/lily/book.cc
+++ b/lily/book.cc
@@ -65,6 +65,7 @@ void
 Book::process (String outname, Music_output_def *default_def, SCM header)
 {
   Paper_book *paper_book = new Paper_book ();
+  paper_book->bookpaper_ = bookpaper_;
   int score_count = scores_.size ();
   for (int i = 0; i < score_count; i++)
     {
@@ -91,6 +92,7 @@ SCM
 Book::to_stencil (Music_output_def *default_def, SCM header)
 {
   Paper_book *paper_book = new Paper_book ();
+  paper_book->bookpaper_ = bookpaper_;
   int score_count = scores_.size ();
   for (int i = 0; i < score_count; i++)
     {

diff --git a/lily/context-def.cc b/lily/context-def.cc
index e4719129ccc705e8ea97b0f16cb6e829be21769f..adb33c9abc009ed6dab75f5f594d82fde52d64ae 100644 (file)
--- a/lily/context-def.cc
+++ b/lily/context-def.cc
@@ -270,6 +270,8 @@ filter_performers (SCM l)
       if (dynamic_cast<Performer*> (unsmob_translator (ly_car (*tail))))
        {
          *tail = ly_cdr (*tail);
+         if (!ly_c_pair_p (*tail))
+           break ;
        }
     }
   return l;
@@ -279,11 +281,14 @@ filter_performers (SCM l)
 SCM
 filter_engravers (SCM l)
 {
-  for (SCM *tail = &l; ly_c_pair_p (*tail) ; tail = SCM_CDRLOC (*tail))
+  SCM *tail = &l;  
+  for (; ly_c_pair_p (*tail) ; tail = SCM_CDRLOC (*tail))
     {
       if (dynamic_cast<Engraver*> (unsmob_translator (ly_car (*tail))))
        {
          *tail = ly_cdr (*tail);
+         if (!ly_c_pair_p (*tail))
+           break ;
        }
     }
   return l;

diff --git a/lily/include/book-paper-def.hh b/lily/include/book-paper-def.hh
index e022e315b349835aa3d0706bd13d92d564250b1d..a0f3bcfab6babb9c24fb4fefbbcb1d69372dbf94 100644 (file)
--- a/lily/include/book-paper-def.hh
+++ b/lily/include/book-paper-def.hh
@@ -19,7 +19,7 @@ class Book_paper_def
 
 public:
   VIRTUAL_COPY_CONSTRUCTOR (Book_paper_def, Book_paper_def);
-  Book_paper_def(Book_paper_def const &);
+  Book_paper_def (Book_paper_def const &);
   SCM scope_;
   SCM scaled_fonts_;
   Real output_scale_;

diff --git a/lily/include/paper-book.hh b/lily/include/paper-book.hh
index b5efa753e948ef9eab62675d3532b9cabfa5dabf..e0cab4c45b01cff0af6ad3c06e604f99dcc875fe 100644 (file)
--- a/lily/include/paper-book.hh
+++ b/lily/include/paper-book.hh
@@ -32,9 +32,9 @@ class Paper_book
   Real height_;
   SCM copyright_;
   SCM tagline_;
-
 public:
   Array<Score_lines> score_lines_;
+  Book_paper_def *bookpaper_;
 
   Paper_book ();
 

diff --git a/lily/paper-book.cc b/lily/paper-book.cc
index 8fbc9fbd2ddd6d1fe69c7c1a455ea73db988f3b8..c4cc819c96c8fcde7eb0b32cb1a69ada330385ec 100644 (file)
--- a/lily/paper-book.cc
+++ b/lily/paper-book.cc
@@ -16,6 +16,7 @@
 #include "paper-score.hh"
 #include "stencil.hh"
 #include "warn.hh"
+#include "book-paper-def.hh"
 
 // JUNKME
 SCM
@@ -38,7 +39,7 @@ Paper_book::Paper_book ()
 {
   copyright_ = SCM_EOL;
   tagline_ = SCM_EOL;
-  
+  bookpaper_ = 0;
   smobify_self ();
 }
 
@@ -60,6 +61,9 @@ Paper_book::mark_smob (SCM smob)
     b->score_lines_[i].gc_mark ();
 
   scm_gc_mark (b->copyright_);
+  if (b->bookpaper_)
+    scm_gc_mark (b->bookpaper_->self_scm ());
+
   return b->tagline_;
 }
 
@@ -113,12 +117,9 @@ Paper_book::scopes (int i)
 Stencil
 Paper_book::title (int i)
 {
-  /*
-    TODO: get from book-paper definition.
-   */
-  SCM user_title = ly_scheme_function ("user-title");
-  SCM book_title = ly_scheme_function ("book-title");
-  SCM score_title = ly_scheme_function ("score-title");
+  SCM user_title = bookpaper_->lookup_variable (ly_symbol2scm ("user-title"));
+  SCM book_title = bookpaper_->lookup_variable (ly_symbol2scm ("book-title"));
+  SCM score_title = bookpaper_->lookup_variable (ly_symbol2scm ("score-title"));
   SCM field = (i == 0 ? ly_symbol2scm ("bookTitle")
               : ly_symbol2scm ("scoreTitle"));
 

diff --git a/lily/stem.cc b/lily/stem.cc
index cd36896bc3f7727f3a9fdf93ae0b183f98061c93..437a316f701858312fc6f05b81e85c0eda319dc4 100644 (file)
--- a/lily/stem.cc
+++ b/lily/stem.cc
@@ -400,7 +400,7 @@ Stem::position_noteheads (Grob*me)
   Real w = Note_head::head_extent (hed,X_AXIS)[dir];
   for (int i=0; i < heads.size (); i++)
     {
-      heads[i]->translate_axis (w - Note_head::head_extent (heads[i],X_AXIS)[dir],
+      heads[i]->translate_axis (w - Note_head::head_extent (heads[i], X_AXIS)[dir],
                                X_AXIS);
     }
 

diff --git a/ly/book-paper-defaults.ly b/ly/book-paper-defaults.ly
new file mode 100644 (file)
index 0000000..42f29dd
--- /dev/null
+++ b/ly/book-paper-defaults.ly
@@ -0,0 +1,69 @@
+\bookpaper {
+    
+#(define-public (book-title paper scopes)
+  "Generate book title from header strings."
+  
+  (define (get sym)
+    (let ((x (ly:modules-lookup scopes sym)))
+      (if (and x (not (unspecified? x))) x "")))
+  
+  (let ((props (page-properties paper)))
+    
+    (interpret-markup
+     paper props
+     (markup
+      #:column
+      (#:override '(baseline-skip . 4)
+      #:column
+      (#:fill-line
+       (#:normalsize (get 'dedication))
+       #:fill-line
+       (#:huge #:bigger #:bigger #:bigger #:bigger #:bold (get 'title))
+       #:override '(baseline-skip . 3)
+       #:column
+       (#:fill-line
+       (#:large #:bigger #:bigger #:bold (get 'subtitle))
+       #:fill-line (#:bigger #:bigger #:bold (get 'subsubtitle)))
+       #:override '(baseline-skip . 5)
+       #:column ("")
+       #:override '(baseline-skip . 2.5)
+       #:column
+       (#:fill-line
+       (#:bigger (get 'poet) #:large #:bigger #:caps (get 'composer))
+       #:fill-line (#:bigger (get 'texttranslator) #:bigger (get 'opus))
+       #:fill-line
+       (#:bigger (get 'meter) #:bigger (get 'arranger))
+       ""
+       #:fill-line (#:large #:bigger (get 'instrument))
+       " "
+       #:fill-line (#:large #:bigger #:caps (get 'piece) ""))))))))
+
+#(define-public (user-title paper markup)
+  "Generate book title from header markup."
+  (if (markup? markup)
+      (let ((props (page-properties paper))
+           (baseline-skip (chain-assoc-get 'baseline-skip props 2)) )
+       (stack-lines DOWN 0 BASELINE-SKIP
+                    (list (interpret-markup paper props markup))))))
+
+#(define-public (score-title paper scopes)
+  "Generate score title from header strings."
+  
+  (define (get sym)
+    (let ((x (ly:modules-lookup scopes sym)))
+      (if (and x (not (unspecified? x))) x "")))
+  
+  (let ((props (page-properties paper)))
+    
+    (interpret-markup
+     paper props
+     (markup
+      #:column
+      (#:override '(baseline-skip . 4)
+      #:column
+      (#:fill-line
+       ("" (get 'opus))
+       #:fill-line (#:large #:bigger #:caps (get 'piece) "")))))))
+
+
+}

diff --git a/ly/declarations-init.ly b/ly/declarations-init.ly
index f0fc60ee7bfe31284767e96bbd89e022847aa08b..6561b0da040fa026e86067c11ac7a1cbb3e54f8b 100644 (file)
--- a/ly/declarations-init.ly
+++ b/ly/declarations-init.ly
@@ -92,7 +92,7 @@ melismaEnd = #(make-span-event 'ManualMelismaEvent STOP)
 
 #(define-public $defaultbookpaper (ly:make-bookpaper 1.7573))
   
-
+\include "book-paper-defaults.ly"
 
 #(set-default-paper-size "a4")
 

diff --git a/scm/fret-diagrams.scm b/scm/fret-diagrams.scm
new file mode 100644 (file)
index 0000000..7365aea
--- /dev/null
+++ b/scm/fret-diagrams.scm
@@ -0,0 +1,283 @@
+(define nil '())
+(define (fret-parse-string definition-string)
+ "parse a fret diagram string and return an alist with the appropriate values"
+   (let* ((fret-count 4)
+          (string-count 6)
+          (thickness 0.05)
+          (finger-code 0)
+          (dot-size 0.25)
+          (position 0.6)
+          (fret-range (list 1 fret-count))
+          (barre-list '())
+          (dot-list '())
+          (xo-list '())
+          (output-list '())
+          (items (string-split definition-string #\;)))
+      (let parse-item ((myitems items))
+          (if (not (null?  (cdr myitems))) 
+              (let ((test-string (car myitems)))
+                 (case (car (string->list (substring test-string 0 1))) 
+                    ((#\f) (set! finger-code (get-numeric-from-key test-string)))
+                    ((#\t) (set! thickness (get-numeric-from-key test-string)))
+                    ((#\c) (set! barre-list (cons* (numerify (string-split (substring test-string 2) #\-))
+                                            barre-list)))
+                    ((#\h) (set! fret-count (get-numeric-from-key test-string)))
+                    ((#\w) (set! string-count (get-numeric-from-key test-string)))
+                    ((#\d) (set! dot-size (get-numeric-from-key test-string)))
+                    ((#\p) (set! position (get-numeric-from-key test-string)))
+                    (else 
+                       (let ((this-list (string-split test-string #\-)))
+                           ;(display this-list)
+                           (if (string->number (cadr this-list))
+                              (set! dot-list (cons* (numerify this-list) dot-list))
+                              (set! xo-list (cons* (numerify this-list) xo-list))))))
+                 (parse-item (cdr myitems)))))
+               ; calculate fret-range
+               (let ((maxfret 0) (minfret 99))
+                    (let updatemax ((fret-list dot-list))
+                        (if (null?  fret-list)
+                           '()
+                           (let ((fretval (cadar fret-list)))
+                               (if (> fretval maxfret) (set! maxfret fretval))
+                               (if (< fretval minfret) (set! minfret fretval))
+                               (updatemax (cdr fret-list)))))
+                    (if (> maxfret fret-count)
+                        (set! fret-range (list minfret
+                             (let ((upfret (- (+ minfret fret-count) 1)))
+                                  (if (> maxfret upfret) maxfret upfret)))))
+                    ; subtract fret from dots
+                    (set! dot-list (subtract-base-fret (- (car fret-range) 1) dot-list)))      
+               (acons "string-count" string-count
+               (acons "dot-size" dot-size
+               (acons "position" position
+               (acons "finger-code" finger-code
+               (acons "fret-range" fret-range
+               (acons "thickness" thickness
+               (acons "barre-list" barre-list
+               (acons "dot-list" dot-list
+               (acons "xo-list" xo-list '())))))))))))
+   
+(define (subtract-base-fret base-fret dot-list)
+  
+  (if (null? dot-list)
+      '()
+      (let ((this-list (car dot-list)))
+      (cons* (list (car this-list) (- (cadr this-list) base-fret) (if (null? (cddr this-list))
+                                                                    nil
+                                                                    (caddr this-list)))
+             (subtract-base-fret base-fret (cdr dot-list))))))
+
+(define (draw-strings string-count fret-range th size)
+  (let* ((fret-count (+ (- (cadr fret-range) (car fret-range)) 1))
+         (sl (* (+ fret-count 1) size))
+         (half-thickness (* th 0.5))
+         (string-stencil (ly:make-stencil (list 'draw-line th 0 0 0 sl)
+                         (cons (- half-thickness) half-thickness)
+                         (cons (- half-thickness) (+ sl half-thickness)))))
+    (if (= string-count 1)
+         string-stencil
+        (ly:stencil-combine-at-edge
+         (draw-strings (- string-count 1) fret-range th size) 0 1
+         string-stencil
+         (- size th) 0))))
+
+(define (draw-fret-lines fret-count string-count th size)
+    (let* ((fret-length (* (- string-count 1) size))
+          (half-thickness (* th 0.5))
+          (fret-line (ly:make-stencil (list 'draw-line th 0 size fret-length size)
+                          (cons 0 fret-length)
+                          (cons (- size half-thickness) (+  size half-thickness)))))
+       (if (= fret-count 1)
+         fret-line
+         (ly:stencil-combine-at-edge fret-line Y UP
+          (draw-fret-lines (- fret-count 1) string-count th size)
+          (- size th) 0))))
+ 
+(define (draw-frets paper fret-range string-count th size)
+  (let* ((fret-count (+ (- (cadr fret-range) (car fret-range)) 1))
+         (fret-length (* (- string-count 1) size))
+         (half-thickness (* th 0.5))
+         (base-fret (car fret-range)))
+       (ly:stencil-combine-at-edge
+          (draw-fret-lines fret-count string-count th size) Y UP
+             (if (= base-fret 1)
+                 (draw-fret-lines 1 string-count (* th 2) size)
+                 (draw-fret-lines 1 string-count th size)) 
+                 (- size th) 0))) 
+
+(define (draw-dots paper string-count fret-range size dot-size position finger-code dot-list)
+  "Make dots for fret diagram."
+  (let* ((dot-radius (* size dot-size))
+         (fret-count (+ (- (cadr fret-range) (car fret-range) 1)))
+         (mypair (car dot-list))
+         (restlist (cdr dot-list))
+         (xpos (* (- string-count (car mypair)) size))
+         (ypos (* (+ 4 (- fret-count (cadr mypair) position )) size))
+         (finger (caddr mypair))
+         (font (ly:paper-get-font paper `(((font-magnification . ,(* 0.8 size))(font-name . "cmss8")
+                                        (font-encoding Tex-text)))))
+         (font2 (ly:paper-get-font paper `(((font-magnification . ,(* (* 2 dot-size) size))(font-name . "cmss8")
+                                        (font-encoding Tex-text)))))
+         (font3 (ly:paper-get-font paper `(((font-magnification . ,(* (* 3 dot-size) size))(font-name . "cmss8")
+                                        (font-encoding Tex-text)))))
+         (extent (cons (- (*  size 0.25)) (*  size 0.25)))
+         (dotstencil (if (or (eq? finger nil)(eq? finger-code 0))
+                          (ly:make-stencil (list 'dot xpos ypos dot-radius ) extent extent)
+                          (if (eq? finger-code 1)
+  ; TODO -- Get nice circled numbers in the font, instead of this kludge
+                             (ly:stencil-add 
+                               (ly:stencil-translate-axis 
+                                   (ly:stencil-translate-axis 
+                                       (fontify-text font2 (number->string finger)) (- xpos (* size 0.3)) X)
+                                   (- ypos (* 1 dot-size size)) Y)
+                               (ly:stencil-translate-axis 
+                                   (ly:stencil-translate-axis 
+                                       (fontify-text font3 "O") (- xpos (* 2.2 dot-size size)) X)
+                                   (- ypos (* 1.7 dot-size size)) Y))
+                          (if (eq? finger-code 2) 
+                              (ly:stencil-add 
+                                   (ly:make-stencil (list 'dot xpos ypos dot-radius ) extent extent)
+                                   (ly:stencil-translate-axis 
+                                        (ly:stencil-translate-axis 
+                                              (fontify-text font (number->string finger)) (- xpos (* size 0.3)) X)
+                                        (- size) Y)))))))
+    (if (null? restlist)
+        dotstencil
+        (ly:stencil-add (draw-dots paper string-count fret-range size dot-size position finger-code restlist)
+                         dotstencil))))
+
+(define (draw-xo paper string-count fret-range size xo-list) 
+"Put x and o on chord diagram."
+    (let* ((dot-radius (* size 0.25))
+           (fret-count (+ (- (cadr fret-range) (car fret-range) 1)))
+           (font (ly:paper-get-font paper `(((font-size . ,(* -5 (+ 1 (* 2.6 (- 1 size)))))(font-family . music)))))
+           (mypair (car xo-list))
+           (restlist (cdr xo-list))
+;TODO -- get better glyphs in font to use for x (mute string) and o (open string)
+;        Perhaps explore just using sans-serif font?
+           (glyph-name (if (char=? (cadr mypair) #\x) "noteheads-2cross"
+                         "scripts-open"))
+           (tmpdot (if (char=? (cadr mypair) #\x) 0 (* size 0.25)))
+           (xpos (if (char=? (cadr mypair) #\x)
+                (- (* (- string-count (car mypair)) size) (* .35 size) )
+                (* (- string-count (car mypair)) size)))
+          (ypos (* (+ 3.5 fret-count) size))
+          (extent (cons (- (* size 0.25)) (* size 0.25)))
+          (glyph-stencil (ly:stencil-translate-axis 
+                (ly:stencil-translate-axis (ly:find-glyph-by-name font glyph-name) ypos Y)
+                xpos X)))
+      (if (null? restlist)
+          glyph-stencil
+          (ly:stencil-add
+            (draw-xo paper string-count fret-range size restlist)
+            glyph-stencil))))
+
+(define (make-bezier-sandwich-list left right bottom height thickness)
+   (let* ((width (+ (- right left) 1))
+          (x1 (+ (* width 0.1) left))
+          (x2 (- right (* width 0.1)))
+          (bottom-control-point-height (+ bottom (- height thickness)))
+          (top-control-point-height (+ bottom height)))
+; order of points is: left cp low, right cp low, right end low, left end low
+;                     right cp high, left cp high, left end high, right end high.
+       (list (cons x1 bottom-control-point-height) (cons x2 bottom-control-point-height) (cons right bottom) (cons left bottom)
+             (cons x2 top-control-point-height) (cons x1 top-control-point-height) (cons left bottom) (cons right bottom))))
+
+(define (draw-barre paper string-count fret-range size barre-list)
+   "Create barre indications for a chord diagram"
+   (if (not (null? barre-list))
+     (let* ((string1 (caar barre-list))
+            (string2 (cadar barre-list))
+            (fret    (caddar barre-list))
+            (bottom (* size (+ 1.5 (- (cadr fret-range) fret))))
+            (left (* size (- string-count string1)))
+            (right (* size (- string-count string2)))
+            (bezier-list (make-bezier-sandwich-list left right bottom (* size 0.5) (* size 0.1)))
+            (sandwich-stencil (ly:make-stencil (list 'bezier-sandwich `(quote ,bezier-list) (* size 0.1) )
+                                  (cons 0 right)
+                                  (cons 0 (+ bottom (* size 0.8))))))
+        (if (not (null? (cdr barre-list)))
+            (ly:stencil-add sandwich-stencil
+                 (draw-barre paper string-count fret-range size (cdr barre-list)))
+            sandwich-stencil ))))
+ 
+(define (label-fret paper string-count fret-range size)
+   "Label the base fret on a fret diagram"
+   (let ((base-fret (car fret-range))
+         (fret-count (+ (- (cadr fret-range) (car fret-range)) 1))
+         (font (ly:paper-get-font paper `(((font-magnification . ,(* 0.8 size))(font-name . "cmss8")
+                                        (font-encoding Tex-text))))))
+     (ly:stencil-translate-axis 
+        (ly:stencil-translate-axis (fontify-text font (if (> base-fret 1)
+                                                          (format #f "~(~:@r~)" base-fret)
+                                                          " ")) (* (- string-count 0.5) size) X)
+        (* (- fret-count 0.2) size) Y)))
+            
+(define (get-numeric-from-key keystring)
+ "Get the numeric value from a key  of the form k:val"
+    (string->number (substring keystring 2  (string-length keystring) )))
+    
+(define (numerify mylist)
+ "Convert string values to numeric or character"
+     (if (null? mylist)
+         '()
+         (let ((numeric-value (string->number (car mylist))))
+             (if numeric-value
+                (cons* numeric-value (numerify (cdr mylist)))
+                (cons* (car (string->list (car mylist))) (numerify (cdr mylist)))))))
+           
+  
+(define (make-fret-diagram paper size definition-string)
+  "Make a fret diagram"
+  (let* ((parameters (fret-parse-string definition-string))
+         (string-count (cdr (assoc "string-count" parameters)))
+         (fret-range (cdr (assoc "fret-range" parameters)))
+         (finger-code (cdr (assoc "finger-code" parameters)))
+         (dot-size (cdr (assoc "dot-size" parameters)))
+         (position (cdr (assoc "position" parameters)))
+         (dot-list (cdr (assoc "dot-list" parameters)))
+         (xo-list (cdr (assoc "xo-list" parameters)))
+         (line-thickness (cdr (assoc "thickness" parameters)))
+         (barre-list (cdr (assoc "barre-list" parameters)))
+         (fret-diagram-stencil (ly:stencil-add
+                            (draw-strings string-count fret-range line-thickness size)
+                            (draw-frets paper fret-range string-count line-thickness size))))
+         (if (not (null? dot-list))
+             (set! fret-diagram-stencil (ly:stencil-add
+                                    (draw-dots paper string-count fret-range size dot-size position finger-code dot-list)
+                                    fret-diagram-stencil)))
+         (if (not (null? xo-list))
+             (set! fret-diagram-stencil (ly:stencil-add
+                                    (draw-xo paper string-count fret-range size xo-list)
+                                    fret-diagram-stencil)))
+         (if (not (null? barre-list))
+             (set! fret-diagram-stencil (ly:stencil-add
+                                    (draw-barre paper string-count fret-range size barre-list)
+                                    fret-diagram-stencil)))
+         (set! fret-diagram-stencil (ly:stencil-add  fret-diagram-stencil (label-fret paper string-count fret-range size)))
+         (ly:stencil-align-to! fret-diagram-stencil X -.4)
+         fret-diagram-stencil))
+
+(def-markup-command (fret-diagram paper props size definition-string)
+  (number? string?)
+  "Syntax: \\fret-diagram size definition-string
+   eg: \\markup \\fret-diagram #0.75 #\"6-x;5-x;4-o;3-2;2-3;1-2;\"
+    for fret spacing 3/4 of staff space, D chord diagram
+    Syntax rules for @var{definition-string}:
+      Diagram items are separated by semicolons.
+      Possible items:
+      t:number -- set the line thickness (in staff spaces).  Default 0.05
+      h:number -- set the height of the diagram in frets.  Default 4
+      w:number -- set the width of the diagram in strings.  Default 6
+      f:number -- set fingering label type 
+                  (0 = none, 1 = in circle on string, 2 = below string)  Default 0
+      d:number -- set radius of dot, in terms of fret spacing.  Default 0.25
+      p:number -- set the position of the dot in the fret space. 0.5 is centered; 1 is on lower fret bar,
+                  0 is on upper fret bar.  Default 0.6 
+      c:string1-string2-fret -- include a barre mark from string1 to string2 on fret
+      string-fret -- place a dot on string at fret.  If fret is o, string is identified
+                     as open.  If fret is x, string is identified as muted.
+      string-fret-fingering -- place a dot on string at fret, and label with fingering as 
+                               defined by f: code.
+    Note:  There is no limit to the number of fret indications per string."
+       (make-fret-diagram paper size definition-string))

diff --git a/scm/lily.scm b/scm/lily.scm
index a1c81d4775466e8d577693e9c1cd8ea41eae1f46..186e92ade1be9e3c04afeb4b7808d4d3c13c90cb 100644 (file)
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -122,6 +122,15 @@
 ;;; Unassorted utility functions.
 
 
+;; modules
+(define-public (ly:modules-lookup modules sym)
+  "DOCME."
+  (let ((v (module-variable (car modules) sym)))
+    (if (and v (variable-bound? v) (variable-ref v))
+       (variable-ref v)
+       (if (module? (cdr modules)) (ly:modules-lookup (cdr modules) sym)))))
+
+
 ;;;;;;;;;;;;;;;;
 ; alist
 (define-public (assoc-get key alist . default)
@@ -455,6 +464,7 @@ L1 is copied, L2 not.
        "font.scm"
        "encoding.scm"
        
+       "fret-diagrams.scm"
        "define-markup-commands.scm"
        "define-grob-properties.scm"
        "define-grobs.scm"

diff --git a/scm/page-layout.scm b/scm/page-layout.scm
index 53d4a434188a423a1778d6a21ec53818162599c2..26c37b474a177e28da4b189274a6541f4edfac8f 100644 (file)
--- a/scm/page-layout.scm
+++ b/scm/page-layout.scm
@@ -4,82 +4,12 @@
 ;;;; 
 ;;;; (c) 2004 Jan Nieuwenhuizen <janneke@gnu.org>
 
-(define (ly:modules-lookup modules sym)
-  (let ((v (module-variable (car modules) sym)))
-    (if (and v (variable-bound? v) (variable-ref v))
-       (variable-ref v)
-       (if (module? (cdr modules)) (ly:modules-lookup (cdr modules) sym)))))
 
 (define-public (page-properties paper)
   (list (append `((linewidth . ,(ly:paper-get-number
                                 paper 'linewidth)))
                (ly:paper-lookup paper 'text-font-defaults))))
 
-(define-public (book-title paper scopes)
-  "Generate book title from header strings."
-  
-  (define (get sym)
-    (let ((x (ly:modules-lookup scopes sym)))
-      (if (and x (not (unspecified? x))) x "")))
-  
-  (let ((props (page-properties paper)))
-    
-    (interpret-markup
-     paper props
-     (markup
-      #:column
-      (#:override '(baseline-skip . 4)
-      #:column
-      (#:fill-line
-       (#:normalsize (get 'dedication))
-       #:fill-line
-       (#:huge #:bigger #:bigger #:bigger #:bigger #:bold (get 'title))
-       #:override '(baseline-skip . 3)
-       #:column
-       (#:fill-line
-       (#:large #:bigger #:bigger #:bold (get 'subtitle))
-       #:fill-line (#:bigger #:bigger #:bold (get 'subsubtitle)))
-       #:override '(baseline-skip . 5)
-       #:column ("")
-       #:override '(baseline-skip . 2.5)
-       #:column
-       (#:fill-line
-       (#:bigger (get 'poet) #:large #:bigger #:caps (get 'composer))
-       #:fill-line (#:bigger (get 'texttranslator) #:bigger (get 'opus))
-       #:fill-line
-       (#:bigger (get 'meter) #:bigger (get 'arranger))
-       ""
-       #:fill-line (#:large #:bigger (get 'instrument))
-       " "
-       #:fill-line (#:large #:bigger #:caps (get 'piece) ""))))))))
-
-(define-public (user-title paper markup)
-  "Generate book title from header markup."
-  (if (markup? markup)
-      (let ((props (page-properties paper))
-           (baseline-skip (chain-assoc-get 'baseline-skip props 2)) )
-       (stack-lines DOWN 0 BASELINE-SKIP
-                    (list (interpret-markup paper props markup))))))
-
-(define-public (score-title paper scopes)
-  "Generate score title from header strings."
-  
-  (define (get sym)
-    (let ((x (ly:modules-lookup scopes sym)))
-      (if (and x (not (unspecified? x))) x "")))
-  
-  (let ((props (page-properties paper)))
-    
-    (interpret-markup
-     paper props
-     (markup
-      #:column
-      (#:override '(baseline-skip . 4)
-      #:column
-      (#:fill-line
-       ("" (get 'opus))
-       #:fill-line (#:large #:bigger #:caps (get 'piece) "")))))))
-
 (define-public (plain-header paper page-number)
   (let ((props (page-properties paper) ))
     (interpret-markup paper props

diff --git a/scm/paper.scm b/scm/paper.scm
index c4a1471b62d68a5c0acb6ed85793d35071579183..1cc32532bd0736fa54e1e395e4534cd6ce68c5de 100644 (file)
--- a/scm/paper.scm
+++ b/scm/paper.scm
@@ -26,7 +26,7 @@
 
     (module-define! m 'dimension-variables
                    '(pt mm cm in staffheight staff-space
-                        linewidth
+                        linewidth indent hsize vsize
                         staffspace linethickness ledgerlinethickness
                         blotdiameter interscoreline))
     ))