X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Ffret-diagrams.scm;fp=scm%2Ffret-diagrams.scm;h=acc095a567ec8a602fd7d4cebf1f03e8274825bb;hb=e90f0536f9be39ada0bef0aeb0d275dec3b2fb5b;hp=cb7ee6dbaab29999f1fe803d69432ba01f896556;hpb=a8c9e8a7ca320ab0df5fd32e717fd62cd7635ce6;p=lilypond.git diff --git a/scm/fret-diagrams.scm b/scm/fret-diagrams.scm index cb7ee6dbaa..acc095a567 100644 --- a/scm/fret-diagrams.scm +++ b/scm/fret-diagrams.scm @@ -1,8 +1,19 @@ -;;;; fret-diagrams.scm -- +;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; source file of the GNU LilyPond music typesetter +;;;; Copyright (C) 2004--2011 Carl D. Sorensen ;;;; -;;;; (c) 2004--2009 Carl D. Sorensen +;;;; 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 . ; ; Utility functions @@ -61,10 +72,20 @@ to end-point." (if (null? dot-list) '() (let ((this-list (car dot-list))) - (cons* (list (car this-list) (- (second this-list) base-fret) - (if (null? (cddr this-list)) - '() - (third this-list))) + (cons* (list + ;; string + (car this-list) + ;; fret + (- (second this-list) base-fret) + ;; finger + (if (null? (cddr this-list)) + '() + (third this-list)) + ;; color modifier + (if (or (null? (cddr this-list)) + (null? (cdddr this-list))) + '() + (fourth this-list))) (subtract-base-fret base-fret (cdr dot-list)))))) (define (drop-paren item-list) @@ -89,7 +110,7 @@ to end-point." (define (merge-details key alist-list . default) "Return @code{alist-list} entries for @code{key}, in one combined alist. -There can be two @code{alist-list} entries for a given key. The first +There can be two @code{alist-list} entries for a given key. The first comes from the override-markup function, the second comes from property settings during a regular override. This is necessary because some details can be set in one @@ -101,9 +122,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,33 +267,32 @@ 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 (chain-assoc-get 'align-dir props -0.4)) ; needed only here - (xo-padding - (* size (assoc-get 'xo-padding details 0.2))) ; needed only here + (xo-padding (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 '())) @@ -294,7 +314,7 @@ with magnification @var{mag} of the string @var{text}." (cons string-coordinate (- fret-coordinate))))) (define (stencil-coordinate-offset fret-offset string-offset) - "Return a pair @code{(x-offset . y-offstet)} + "Return a pair @code{(x-offset . y-offset)} for translation in stencil coordinate system." (cond ((eq? orientation 'landscape) @@ -352,7 +372,7 @@ baseline at fret coordinate @var{base}, a height of "Draw the string lines for a fret diagram with @var{string-count} strings and frets as indicated in @var{fret-range}. Line thickness is given by @var{th}, fret & string spacing by -@var{size}. Orientation is determined by @var{orientation}. " +@var{size}. Orientation is determined by @var{orientation}." (define (helper x) (if (null? (cdr x)) @@ -389,7 +409,7 @@ Line thickness is given by @var{th}, fret & string spacing by "Draw the fret lines for a fret diagram with @var{string-count} strings and frets as indicated in @var{fret-range}. Line thickness is given by @var{th}, fret & string spacing by -@var{size}. Orientation is given by @var{orientation}." +@var{size}. Orientation is given by @var{orientation}." (define (helper x) (if (null? (cdr x)) (fret-stencil (car x)) @@ -520,7 +540,7 @@ fret-diagram overall parameters." (let* ( (scale-dot-radius (* size dot-radius)) (scale-dot-thick (* size th)) - (dot-color (assoc-get 'dot-color details 'black)) + (default-dot-color (assoc-get 'dot-color details 'black)) (finger-label-padding 0.3) (dot-label-font-mag (* scale-dot-radius @@ -544,6 +564,11 @@ fret-diagram overall parameters." (extent (cons (- scale-dot-radius) scale-dot-radius)) (finger (caddr mypair)) (finger (if (number? finger) (number->string finger) finger)) + (inverted-color (eq? 'inverted (cadddr mypair))) + (dot-color (if (or (and (eq? default-dot-color 'black) inverted-color) + (and (eq? default-dot-color 'white) (not inverted-color))) + 'white + 'black)) (dot-stencil (if (eq? dot-color 'white) (ly:stencil-add (make-circle-stencil @@ -630,12 +655,11 @@ fret-diagram overall parameters." "Put open and mute string indications on diagram, as contained in @var{xo-list}." (let* ((xo-font-mag - (* size (assoc-get - 'xo-font-magnification details + (assoc-get 'xo-font-magnification details (cond ((or (eq? orientation 'landscape) (eq? orientation 'opposing-landscape)) 0.4) - (else 0.4))))) + (else 0.4)))) (mypair (car xo-list)) (restlist (cdr xo-list)) (glyph-string (if (eq? (car mypair) 'mute) @@ -698,6 +722,11 @@ at @var{fret}." (fancy-format #f "~@r" base-fret)) ((equal? 'arabic number-type) (fancy-format #f "~d" base-fret)) + ((equal? 'custom number-type) + (fancy-format #f + (assoc-get 'fret-label-custom-format + details "~a") + base-fret)) (else (fancy-format #f "~(~@r~)" base-fret)))) (label-stencil (centered-stencil @@ -712,7 +741,7 @@ at @var{fret}." (ly:stencil-translate label-stencil (stencil-coordinates - (1+ (* size label-vertical-offset)) + (* size (+ 1.0 label-vertical-offset)) (if (eq? label-dir LEFT) (- label-outside-diagram) (+ (* size (1- string-count)) label-outside-diagram)))))) @@ -751,7 +780,7 @@ at @var{fret}." xo-stencil 'fret orientation)) (xo-stencil-offset (stencil-coordinate-offset - (- diagram-fret-top + (- diagram-fret-top xo-fret-offset (* size xo-padding)) 0))) @@ -916,14 +945,14 @@ a fret-indication list with the appropriate values" `(,props . ,output-list))) ; ugh -- hard coded; proc is better -(define-builtin-markup-command +(define-markup-command (fret-diagram-verbose layout props marking-list) (pair?) ; argument type (list, but use pair? for speed) - instrument-specific-markup ; markup type - ((align-dir -0.4) ; properties and defaults - (size 1.0) - (fret-diagram-details) - (thickness 0.5)) + #:category instrument-specific-markup ; markup type + #:properties ((align-dir -0.4) ; properties and defaults + (size 1.0) + (fret-diagram-details) + (thickness 0.5)) "Make a fret diagram containing the symbols indicated in @var{marking-list}. For example, @@ -955,12 +984,15 @@ Place a capo indicator (a large solid bar) across the entire fretboard at fret location @var{fret-number}. Also, set fret @var{fret-number} to be the lowest fret on the fret diagram. -@item (place-fret @var{string-number} @var{fret-number} @var{finger-value}) +@item (place-fret @var{string-number} @var{fret-number} [@var{finger-value} [@var{color-modifier}]]) Place a fret playing indication on string @var{string-number} at fret -@var{fret-number} with an optional fingering label @var{finger-value}. +@var{fret-number} with an optional fingering label @var{finger-value}, +and an optional color modifier @var{color-modifier}. By default, the fret playing indicator is a solid dot. This can be -changed by setting the value of the variable @var{dot-color}. If the -@var{finger} part of the @code{place-fret} element is present, +globally changed by setting the value of the variable @var{dot-color}. +Setting @var{color-modifier} to @code{inverted} inverts the dot color +for a specific fingering. +If the @var{finger} part of the @code{place-fret} element is present, @var{finger-value} will be displayed according to the setting of the variable @var{finger-code}. There is no limit to the number of fret indications per string. @@ -969,10 +1001,10 @@ indications per string. (make-fret-diagram layout props marking-list)) -(define-builtin-markup-command (fret-diagram layout props definition-string) +(define-markup-command (fret-diagram layout props definition-string) (string?) ; argument type - instrument-specific-markup ; markup category - (fret-diagram-verbose-markup) ; properties and defaults + #:category instrument-specific-markup ; markup category + #:properties (fret-diagram-verbose-markup) ; properties and defaults "Make a (guitar) fret diagram. For example, say @example @@ -1046,11 +1078,11 @@ Note: There is no limit to the number of fret indications per string. (fret-diagram-verbose-markup layout (car definition-list) (cdr definition-list)))) -(define-builtin-markup-command +(define-markup-command (fret-diagram-terse layout props definition-string) (string?) ; argument type - instrument-specific-markup ; markup category - (fret-diagram-verbose-markup) ; properties + #:category instrument-specific-markup ; markup category + #:properties (fret-diagram-verbose-markup) ; properties "Make a fret diagram markup using terse string-based syntax. Here is an example