]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/fret-diagrams.scm
define-music-types.scm: Fix indentation.
[lilypond.git] / scm / fret-diagrams.scm
index ce627b50fe137d2e218148aa101a61c1ab103d40..b74bbc145347febdf4fc2e3c2b5c4dbbb1c06262 100644 (file)
@@ -101,9 +101,9 @@ found."
   (define (helper key alist-list default)
     (if (null? alist-list)
         default
-        (let* ((handle (assoc key (car alist-list))))
-          (if (pair? handle)
-              (append (cdr handle) (chain-assoc-get key (cdr alist-list) '()))
+        (let* ((entry (assoc-get key (car alist-list))))
+          (if entry
+              (append entry (chain-assoc-get key (cdr alist-list) '()))
               (helper key (cdr alist-list) default)))))
 
   (helper key alist-list
@@ -246,20 +246,20 @@ with magnification @var{mag} of the string @var{text}."
            (if (eq? finger-code 'in-dot) 0.425 0.25)) ; bigger dots if labeled
          (default-dot-position
            (if (eq? finger-code 'in-dot)
-             (- 0.95 default-dot-radius)
-             0.6)) ; move up to make room for bigger dot if labeled
+               (- 0.95 default-dot-radius)
+               0.6)) ; move up to make room for bigger dot if labeled
          (dot-radius
            (assoc-get
              'dot-radius details default-dot-radius))  ; needed for draw-dots
-         ; and draw-barre
+                                                       ; and draw-barre
          (dot-position
            (assoc-get
-             'dot-position details default-dot-position)) ; needed for draw-dots
-         ; and draw-barre
+             'dot-position details default-dot-position)) ; needed for
+                                                    ; draw-dots and draw-barre
          (th
            (* (ly:output-def-lookup layout 'line-thickness)
               (chain-assoc-get 'thickness props 0.5))) ; needed for draw-frets
-         ; and draw-strings
+                                                       ; and draw-strings
          (sth (* size th))
          (thickness-factor (assoc-get 'string-thickness-factor details 0))
          (alignment
@@ -268,11 +268,11 @@ with magnification @var{mag} of the string @var{text}."
            (* size (assoc-get 'xo-padding details 0.2))) ; needed only here
          (parameters (fret-parse-marking-list marking-list my-fret-count))
          (capo-fret (assoc-get 'capo-fret parameters 0))
-         (dot-list (cdr (assoc 'dot-list parameters)))
-         (xo-list (cdr (assoc 'xo-list parameters)))
-         (fret-range (cdr (assoc 'fret-range parameters)))
+         (dot-list (assoc-get 'dot-list parameters))
+         (xo-list (assoc-get 'xo-list parameters))
+         (fret-range (assoc-get 'fret-range parameters))
          (my-fret-count (fret-count fret-range))
-         (barre-list (cdr (assoc 'barre-list parameters)))
+         (barre-list (assoc-get 'barre-list parameters))
          (barre-type
            (assoc-get 'barre-type details 'curved))
          (fret-diagram-stencil '()))
@@ -293,6 +293,19 @@ with magnification @var{mag} of the string @var{text}."
         (else
           (cons string-coordinate (- fret-coordinate)))))
 
+    (define (stencil-coordinate-offset fret-offset string-offset)
+      "Return a pair @code{(x-offset . y-offset)}
+      for translation in stencil coordinate system."
+      (cond
+        ((eq? orientation 'landscape)
+         (cons fret-offset (- string-offset)))
+        ((eq? orientation 'opposing-landscape)
+         (cons (- fret-offset) string-offset))
+        (else
+          (cons string-offset (- fret-offset)))))
+
+
+
     (define (make-bezier-sandwich-list start stop base height
                                        half-thickness)
       "Make the argument list for a bezier sandwich from
@@ -642,6 +655,7 @@ fret-diagram overall parameters."
          (if (null? restlist)
            positioned-glyph
            (ly:stencil-add
+             positioned-glyph
              (draw-xo restlist)))))
 
        (define (draw-capo fret)
@@ -734,18 +748,19 @@ at @var{fret}."
              (xo-stencil (draw-xo xo-list))
              (xo-fret-offset
                (stencil-fretboard-offset
-                 xo-stencil 'fret orientation)))
+                 xo-stencil 'fret orientation))
+             (xo-stencil-offset
+              (stencil-coordinate-offset
+               (- diagram-fret-top
+                  xo-fret-offset
+                  (* size xo-padding))
+               0)))
         (set! fret-diagram-stencil
           (ly:stencil-add
             fret-diagram-stencil
             (ly:stencil-translate
               xo-stencil
-              (stencil-coordinates
-                (- diagram-fret-top
-                   xo-fret-offset
-                   (* size xo-padding))
-                0)))))) ; no string offset
-
+              xo-stencil-offset)))))
     (if (> capo-fret 0)
       (set! fret-diagram-stencil
         (ly:stencil-add