From 879202851f7b3d03c67445af0725fcfbd0709940 Mon Sep 17 00:00:00 2001 From: Carl Sorensen Date: Sat, 21 Jun 2008 20:28:21 -0600 Subject: [PATCH] Revert "Fret-diagrams refactoring that puts all properties" This reverts commit 85d6ce05f3db56aa6f484c4fbe160da0ce000167. --- input/regression/fret-diagrams.ly | 133 ++++++++--------- scm/define-grob-interfaces.scm | 8 +- scm/define-grob-properties.scm | 99 +++++-------- scm/fret-diagrams.scm | 291 ++++++++++++++++++-------------------- 4 files changed, 228 insertions(+), 303 deletions(-) rewrite input/regression/fret-diagrams.ly (93%) diff --git a/input/regression/fret-diagrams.ly b/input/regression/fret-diagrams.ly dissimilarity index 93% index 62a9c36a57..a66735c40e 100644 --- a/input/regression/fret-diagrams.ly +++ b/input/regression/fret-diagrams.ly @@ -1,77 +1,56 @@ -\version "2.11.27" - -\paper { - ragged-right = ##t -} - -<< - \chords {a2 a c c d} - - \new Voice =mel { - \textWidthOn - %% A chord for ukelele - a'2 ^\markup - \override #'(fret-diagram-details . ( - ((string-count . 4) - (dot-color . white) - (finger-code . in-dot)))){ - \fret-diagram #"4-2-2;3-1-1;2-o;1-o;"} - %% A chord for ukelele, with formatting defined in definition string - % 1.2 * size, 4 strings, 4 frets, fingerings below string - % dot radius .35 of fret spacing, dot position 0.55 of fret spacing - a'2 ^\markup - \override #'(fret-diagram-details . ( - ((dot-color . white) - (open-string . "o")))){ - \fret-diagram #"s:1.2;w:4;h:3;f:2;d:0.35;p:0.55;4-2-2;3-1-1;2-o;1-o;"} - - %% C major for guitar, barred on third fret - % verbose style - % roman fret label, finger labels below string, straight barre - c' ^\markup - \override #'(size . 1.1) { % 110% of default size - \override #'(fret-diagram-details . (( - (number-type . roman-lower) - (finger-code . below-string) - (barre-type . straight)))) { - \fret-diagram-verbose #'((mute 6) - (place-fret 5 3 1) - (place-fret 4 5 2) - (place-fret 3 5 3) - (place-fret 2 5 4) - (place-fret 1 3 1) - (barre 5 1 3)) }} - - %% C major for guitar, barred on third fret - % verbose style - c' ^\markup - \override #'(size . 1.1) { % 110% of default size - \override #'(fret-diagram-details . (( - (number-type . arabic) - (dot-label-font-mag . 0.9) - (finger-code . in-dot) - (fret-label-font-mag . 0.6) - (fret-label-vertical-offset . 0) - (label-dir . -1) - (mute-string . "M") - (orientation . landscape) - (xo-font-magnification . 0.4) - (xo-padding . 0.3)))) { - \fret-diagram-verbose #'((mute 6) - (place-fret 5 3 1) - (place-fret 4 5 2) - (place-fret 3 5 3) - (place-fret 2 5 4) - (place-fret 1 3 1) - (barre 5 1 3)) }} - %% simple D chord - - d' ^\markup - \override #'(fret-diagram-details . (( - (finger-code . below-string) - (dot-radius . 0.35) - (dot-position . 0.5) - (fret-count . 3)))) { - \fret-diagram-terse #"x;x;o;2-1;3-2;2-3;" } - } ->> + +\version "2.10.0" +\header { + texidoc = "Fret diagrams can be created with @code{\markup}." +} +\paper { + + %% stretch to prevent diagrams from colliding. + line-width = 18.0 \cm +} + + +<< + \chords {s2 c c c d} + + \new Voice =mel { + + %% A chord for ukelele + a'2 ^\markup + \override #'(string-count . 4) { + \override #'(dot-color . white) { + \fret-diagram #"4-2-2;3-1-1;2-o;1-o;"}} + + %% C major for guitar, barred on third fret + c' ^\markup + \override #'(number-type . roman-lower) { % lower-case roman numeral fret label + \override #'(size . 1.1) { % 110% of default size + \override #'(finger-code . below-string) { % string labels below strings + \override #'(barre-type . straight) { % straight barre + \fret-diagram-verbose #'((mute 6) (place-fret 5 3 1) (place-fret 4 5 2) (place-fret 3 5 3) (place-fret 2 5 4) (place-fret 1 3 1) (barre 5 1 3)) }}}} + %% C major for guitar, barred on third fret + c' ^\markup + \override #'(number-type . arabic) { % lower-case roman numeral fret label + \override #'(dot-color . white) { % white dots + \override #'(finger-code . in-dot) { % string labels in dots + \override #'(barre-type . curved) { % straight barre + \fret-diagram-verbose #'((mute 6) (place-fret 5 3 1) (place-fret 4 5 2) (place-fret 3 5 3) (place-fret 2 5 4) (place-fret 1 3 1) (barre 5 1 3)) }}}} + %% C major for guitar, barred on third fret + c' ^\markup + \override #'(number-type . roman-upper) { % upper-case roman numeral fret label + \override #'(label-dir . -1) { % label fret at left side of diagram + \override #'(finger-code . in-dot) { % string labels in dots + \override #'(barre-type . curved) { % curved barre + \fret-diagram-verbose #'((mute 6) (place-fret 5 3 1) (place-fret 4 5 2) (place-fret 3 5 3) (place-fret 2 5 4) (place-fret 1 3 1) (barre 5 1 3)) }}}} + + %% simple D chord + + d' ^\markup + \override #'(finger-code . below-string) { + \override #'(dot-radius . 0.35) { + \override #'(dot-position . 0.5) { + \override #'(fret-count . 5) { + \fret-diagram-terse #"x;x;o;2-1;3-2;2-3;" }}}} + + } +>> diff --git a/scm/define-grob-interfaces.scm b/scm/define-grob-interfaces.scm index 158036b44f..8be7c3e098 100644 --- a/scm/define-grob-interfaces.scm +++ b/scm/define-grob-interfaces.scm @@ -52,9 +52,11 @@ note)." (ly:add-interface 'fret-diagram-interface - "A fret diagram" - - '(align-dir fret-diagram-details size thickness)) + "A fret diagram." + '(align-dir barre-type dot-color dot-radius finger-code fret-count +label-dir number-type size string-count xo-font-magnification +mute-string open-string orientation string-fret-finger-combinations +thickness)) (ly:add-interface 'grace-spacing-interface diff --git a/scm/define-grob-properties.scm b/scm/define-grob-properties.scm index 104ae16fe1..26c735e16e 100644 --- a/scm/define-grob-properties.scm +++ b/scm/define-grob-properties.scm @@ -8,7 +8,7 @@ (define (define-grob-property symbol type? description) (if (not (equal? (object-property symbol 'backend-doc) #f)) (ly:error (_ "symbol ~S redefined") symbol)) - + (set-object-property! symbol 'backend-type? type?) (set-object-property! symbol 'backend-doc description) symbol) @@ -30,7 +30,7 @@ moved relative to its X-parent.") relative to its Y-parent.") (add-stem-support ,boolean? "If set, the @code{Stem} object is -included in this script's support.") +included in this script's support.") (after-line-breaking ,boolean? "Dummy property, used to trigger callback for @code{after-line-breaking}.") (align-dir ,ly:dir? "Which side to align? @code{-1}: left side, @@ -63,6 +63,8 @@ script.") grobs, this should contain only one number.") (bar-size ,ly:dimension? "The size of a bar line.") + (barre-type ,symbol? "Type of barre indication used in a fret +diagram. Choices include @code{curved} and @code{straight}.") (base-shortest-duration ,ly:moment? "Spacing is based on the shortest notes in a piece. Normally, pieces are spaced as if notes at least as short as this are present.") @@ -167,7 +169,10 @@ other object. Otherwise, it determines whether the object is placed @code{#UP}, @code{#CENTER} or @code{#DOWN}. Numerical values may also be used: @code{#UP}=@code{1}, @code{#DOWN}=@code{-1}, @code{#LEFT}=@code{-1}, @code{#RIGHT}=@code{1}, @code{#CENTER}=@code{0}.") + (dot-color ,symbol? "Color of dots. Options include +@code{black} and @code{white}.") (dot-count ,integer? "The number of dots.") + (dot-radius ,number? "Radius of dots.") (duration-log ,integer? "The 2-log of the note head duration, i.e., @code{0} = whole note, @code{1} = half note, etc.") @@ -194,6 +199,9 @@ left side of the item and adding the @q{cdr} on the right side of the item). In order to make a grob take up no horizontal space at all, set this to @code{(+inf.0 . -inf.0)}.") + (finger-code ,symbol? "Code for the type of fingering indication +in a fret diagram. Options include @code{none}, @code{in-dot}, and +@code{below-string}.") (flag-count ,number? "The number of tremolo beams.") (flag-style ,symbol? "A string determining what style of flag glyph is typeset on a @code{Stem}. Valid options include @code{()} @@ -226,68 +234,8 @@ note. This is used by @rinternals{note-collision-interface}.") signature object.") (french-beaming ,boolean? "Use French beaming style for this stem. The stem stops at the innermost beams.") - - (fret-diagram-details ,list? "An alist of detailed grob properties -for fret diagrams. Each alist entry consists of a -(@code{property} . @code{value}) pair. -The properties which can be included in fret-diagram-details -include the following: -@itemize @bullet -@item -@code{barre-type} -- Type of barre indication used. -Choices include @code{curved} and @code{straight}. -@item -@code{dot-color} -- Color of dots. Options include -@code{black} and @code{white}. -@item -@code{dot-label-font-mag} -- Magnification for font used to -label fret dots. Default value 1. -@item -@code{dot-radius} -- Radius of dots. -@item -@code{finger-code} -- Code for the type of fingering indication used. -Options include @code{none}, @code{in-dot}, and -@code{below-string}. -@item -@code{fret-count} -- The number of frets. -@item -@code{fret-label-font-mag} -- The magnification of the font used to label -the lowest fret number. Default 0.5 -@item -@code{fret-label-vertical-offset} -- The vertical offset of the fret label -from the fret. Default -0.2 -@item -@code{label-dir} -- Side to which the fret label is attached. -@code{-1}, @code{#LEFT}, or @code{#DOWN} for left or down; -@code{1}, @code{#RIGHT}, or @code{#UP} for right or up. -@item -@code{mute-string} -- Character string to be used to indicate muted string. -@item -@code{number-type} -- Type of numbers to use in fret label. Choices -include @code{roman-lower}, @code{roman-upper}, and @code{arabic}. -@item -@code{open-string} -- Character string to be used to indicate open string. -@item -@code{orientation} -- Orientation of fret-diagram. Options include -@code{normal} and @code{landscape} -@item -@code{string-count} -- The number of strings. -@item -@code{string-label-font-mag} -- The magnification of the font used to label fingerings -at the string, rather than in the dot. Default value 0.6. -@item -@code{top-fret-thickness} -- The thickness of the top fret line, as a multiple -of the standard thickness. Default value 3. -@item -@code{xo-font-magnification} -- Magnification used for mute and -open string indicators. Default value 0.5. -@item -@code{xo-padding} -- Padding for open and mute indicators from top fret. Default -value 0.25. -@end itemize") - - - ;; ugh: double, change. + (fret-count ,integer? "The number of frets in a fret diagram.") + ;; ugh: double, change. (full-size-change ,boolean? "Don't make a change clef smaller.") (gap ,ly:dimension? "Size of a gap in a variable symbol.") @@ -338,6 +286,8 @@ correction amount for kneed beams. Set between @code{0} for no correction and @code{1} for full correction.") (labels ,list? "List of labels (symbols) placed on a column") + (label-dir ,ly:dir? "Side to which a label is attached. +@code{-1} for left, @code{1}@tie{}for right.") (layer ,number? "The output layer (a value between 0 and@tie{}2: Layers define the order of printing objects. Objects in lower layers are overprinted by objects in higher layers.") @@ -424,6 +374,8 @@ get stems extending to the middle staff line.") @code{NonMusicalPaperColumn}.") (note-names ,vector? "Vector of strings containing names for easy-notation note heads.") + (number-type ,symbol? "Type of numbers to use in label. Choices +include @code{roman-lower}, @code{roman-upper}, and @code{arabic}.") (outside-staff-horizontal-padding ,number? "By default, an outside-staff-object can be placed so that is it very close to another @@ -554,11 +506,13 @@ be?") (stencil ,ly:stencil? "The symbol to print.") (stencils ,list? "Multiple stencils, used as intermediate value.") - (strict-grace-spacing ,boolean? "If set, grace notes + (strict-grace-spacing ,boolean? "If set, grace notes are not spaced separately, but put before musical columns.") (strict-note-spacing ,boolean? "If set, unbroken columns with non-musical material (clefs, barlines, etc.) are not spaced separately, but put before musical columns.") + (string-count ,integer? "The number of strings in a fret +diagram.") (string-fret-finger-combinations ,list? "List consisting of @code{(@var{string-number} @var{fret-number} @var{finger-number})} entries.") @@ -631,7 +585,7 @@ be constructed from a whole number of squiggles.") (map (lambda (x) (apply define-internal-grob-property x)) - + `( ;;;;;;;;;;;;;;;; ;; grobs & grob arrays. (alphabetical) @@ -863,7 +817,18 @@ similar to a note head that is part of a ligature.") (x-offset ,ly:dimension? "Extra horizontal offset for ligature heads.") - ))) + ;;;;;;;;;;;;;;;; + ;; fret-diagrams extra properties + (mute-string ,string? "String to be used to indicate a muted string in +fret diagrams") + (open-string ,string? "A string to be used to indicate an open string +in fret diagrams") + (orientation ,symbol? "The orientation of a fret-diagram. Options +include @code{normal} and @code{landscape}.") + (xo-font-magnification ,number? "Magnification used for mute and open +string indicators in fret diagrams.") + + ))) (define-public all-backend-properties (append diff --git a/scm/fret-diagrams.scm b/scm/fret-diagrams.scm index b2e23b8341..7618b91c8e 100644 --- a/scm/fret-diagrams.scm +++ b/scm/fret-diagrams.scm @@ -1,4 +1,4 @@ -;;;; fret-diagrams.scm -- +;;;; fret-diagrams.scm -- ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; @@ -21,7 +21,7 @@ ((eq? my-code 'place-fret) (set! dot-list (cons* (cdr my-item) dot-list)))) (parse-item (cdr mylist))))) - + ;; calculate fret-range (let ((maxfret 0) (minfret 99)) (let updatemax ((fret-list dot-list)) @@ -45,7 +45,7 @@ (define (subtract-base-fret base-fret dot-list) -"Subtract @var{base-fret} from every fret in @var{dot-list}" +"Subtract @var{base-fret} from every fret in @var{dot-list}" (if (null? dot-list) '() (let ((this-list (car dot-list))) @@ -56,7 +56,7 @@ (define (sans-serif-stencil layout props mag text) "create a stencil in sans-serif font based on @var{layout} and @var{props} -with magnification @var{mag} of the string @var{text}." +with magnification @varr{mag} of the string @var{text}." (let* ((my-props (prepend-alist-chain 'font-size (stepmag mag) (prepend-alist-chain 'font-family 'sans props)))) (interpret-markup layout my-props text))) @@ -97,12 +97,12 @@ Line thickness is given by @var{th}, fret & string spacing by with @var{string-count} strings. Line thickness is given by @var{th}, fret & string spacing by @var{size}. Orientation is given by @var{orientation}" (let* (;(fret-length (* (- string-count 1) size)) - (sth (* size th)) + (sth (* size th)) ;(half-thickness (* sth 0.5)) - (gap (- size sth)) + (gap (- size sth)) (fret-line (draw-fret-line string-count th size orientation))) (if (= fret-count 1) - fret-line + fret-line (if (eq? orientation 'normal) (ly:stencil-combine-at-edge (draw-fret-lines (- fret-count 1) string-count th size orientation) Y UP fret-line @@ -126,19 +126,19 @@ fret & string spacing by @var{size}. Orientation is given by @var{orientation}" (cons (- half-thickness) half-thickness) (cons 0 fret-length))))) -(define (draw-thick-zero-fret details string-count th size orientation) +(define (draw-thick-zero-fret props string-count th size orientation) "Draw a thick zeroth fret for a fret diagram whose base fret is not 1." (let* ((sth (* th size)) - ; (top-fret-thick (* sth (chain-assoc-get 'top-fret-thickness details 3.0))) - (top-fret-thick (* sth 3.0)) - ; (top-half-thick (* top-fret-thick 0.5)) - (half-thick (* sth 0.5)) - (x1 half-thick) - (x2 (+ half-thick (* size (- string-count 1)))) - (y1 (- half-thick)) - (y2 (+ top-fret-thick half-thick)) - (x-extent (cons (- x1) x2)) - (y-extent (cons 0 y2))) + ; (top-fret-thick (* sth (chain-assoc-get 'top-fret-thickness props 3.0))) + (top-fret-thick (* sth 3.0)) + ; (top-half-thick (* top-fret-thick 0.5)) + (half-thick (* sth 0.5)) + (x1 half-thick) + (x2 (+ half-thick (* size (- string-count 1)))) + (y1 (- half-thick)) + (y2 (+ top-fret-thick half-thick)) + (x-extent (cons (- x1) x2)) + (y-extent (cons 0 y2))) (if (eq? orientation 'normal) (ly:make-stencil (list 'round-filled-box x1 x2 y1 y2 sth) x-extent y-extent) @@ -146,7 +146,7 @@ fret & string spacing by @var{size}. Orientation is given by @var{orientation}" y-extent x-extent)))) -(define (draw-frets fret-range string-count th size orientation) +(define (draw-frets layout props fret-range string-count th size orientation) "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 @@ -171,18 +171,18 @@ Line thickness is given by @var{th}, fret & string spacing by dot-position dot-radius dot-thickness dot-list orientation) "Make dots for fret diagram." - (let* ((details (chain-assoc-get 'fret-diagram-details props '())) - (scale-dot-radius (* size dot-radius)) + (let* ((scale-dot-radius (* size dot-radius)) (scale-dot-thick (* size dot-thickness)) - (dot-color (chain-assoc-get 'dot-color details 'black)) + (dot-color (chain-assoc-get 'dot-color props 'black)) ; (finger-xoffset (chain-assoc-get 'finger-xoffset props -0.25)) ; (finger-yoffset (chain-assoc-get 'finger-yoffset props (- size))) (finger-xoffset -0.25) (finger-yoffset (- (* size 0.5))) - (dot-label-font-mag (* scale-dot-radius (chain-assoc-get 'dot-label-font-mag details 1.0))) -; (dot-label-font-mag scale-dot-radius) - (string-label-font-mag (* size (chain-assoc-get 'string-label-font-mag details 0.6))) -; (string-label-font-mag (* size 0.6)) +; (dot-label-font-mag (* scale-dot-radius (chain-assoc-get 'dot-label-font-mag props 1.0))) + (dot-label-font-mag scale-dot-radius) +; (string-label-font-mag (* size (chain-assoc-get 'label-font-mag props 0.7))) + (string-label-font-mag (* size 0.6)) +; (fret-count (+ (- (cadr fret-range) (car fret-range) 1))) (mypair (car dot-list)) (restlist (cdr dot-list)) (string (car mypair)) @@ -190,6 +190,8 @@ Line thickness is given by @var{th}, fret & string spacing by (xpos (* size (if (eq? orientation 'normal) (- string-count string) (+ (- fret 1 ) dot-position)))) +;TODO -- figure out what 4 is and get rid of it +;UGH -- 4? (ypos (* size (if (eq? orientation 'normal) (+ 2 (- fret-count fret dot-position )) (- string-count string)))) @@ -197,42 +199,42 @@ Line thickness is given by @var{th}, fret & string spacing by (finger (caddr mypair)) (finger (if (number? finger) (number->string finger) finger)) (dotstencil (if (eq? dot-color 'white) - (ly:stencil-add + (ly:stencil-add (make-circle-stencil scale-dot-radius scale-dot-thick #t) (ly:stencil-in-color - (make-circle-stencil + (make-circle-stencil (- scale-dot-radius (* 0.5 scale-dot-thick)) 0 #t) 1 1 1)) - (make-circle-stencil scale-dot-radius scale-dot-thick #t))) + (make-circle-stencil scale-dot-radius scale-dot-thick #t))) (positioned-dot (begin ;(display dotstencil) (ly:stencil-translate-axis (ly:stencil-translate-axis dotstencil xpos X) ypos Y))) - (labeled-dot-stencil + (labeled-dot-stencil (if (or (eq? finger '())(eq? finger-code 'none)) positioned-dot (if (eq? finger-code 'in-dot) - (let* ((finger-label (centered-stencil + (let* ((finger-label (centered-stencil (sans-serif-stencil layout props dot-label-font-mag finger)))) - (ly:stencil-translate-axis - (ly:stencil-translate-axis - (ly:stencil-add + (ly:stencil-translate-axis + (ly:stencil-translate-axis + (ly:stencil-add dotstencil (if (eq? dot-color 'white) finger-label - (ly:stencil-in-color finger-label 1 1 1))) + (ly:stencil-in-color finger-label 1 1 1))) xpos X) ypos Y)) - (if (eq? finger-code 'below-string) - (ly:stencil-add + (if (eq? finger-code 'below-string) + (ly:stencil-add positioned-dot (if (eq? orientation 'normal) - (ly:stencil-translate-axis - (ly:stencil-translate-axis - (centered-stencil (sans-serif-stencil layout props + (ly:stencil-translate-axis + (ly:stencil-translate-axis + (centered-stencil (sans-serif-stencil layout props string-label-font-mag finger)) xpos X) (* size finger-yoffset) Y) @@ -244,25 +246,25 @@ Line thickness is given by @var{th}, fret & string spacing by ypos Y))) ;unknown finger-code positioned-dot))))) - (if (null? restlist) + (if (null? restlist) labeled-dot-stencil - (ly:stencil-add + (ly:stencil-add (draw-dots layout props string-count fret-count fret-range size finger-code dot-position dot-radius dot-thickness restlist orientation) labeled-dot-stencil)))) (define (draw-xo layout props string-count fret-range size xo-list orientation) "Put open and mute string indications on diagram, as contained in @var{xo-list}." - (let* ((details (chain-assoc-get 'fret-diagram-details props '())) - (fret-count (+ (- (cadr fret-range) (car fret-range) 1))) - (xo-font-mag (* size (chain-assoc-get 'xo-font-magnification details 0.5))) + (let* ((fret-count (+ (- (cadr fret-range) (car fret-range) 1))) + (xo-font-mag (chain-assoc-get 'xo-font-magnification props 0.5)) +; (xo-font-mag 0.5) ; (xo-horizontal-offset (* size (chain-assoc-get 'xo-horizontal-offset props -0.35))) (xo-horizontal-offset (* size -0.35)) (mypair (car xo-list)) (restlist (cdr xo-list)) (glyph-string (if (eq? (car mypair) 'mute) - (chain-assoc-get 'mute-string details "X") - (chain-assoc-get 'open-string details "O"))) + (chain-assoc-get 'mute-string props "X") + (chain-assoc-get 'open-string props "O"))) (xpos (+ (* (- string-count (cadr mypair)) size) xo-horizontal-offset )) (glyph-stencil (if (eq? orientation 'normal) (ly:stencil-translate-axis @@ -315,19 +317,18 @@ Line thickness is given by @var{th}, fret & string spacing by (define (draw-barre layout props string-count fret-range size finger-code dot-position dot-radius barre-list orientation) "Create barre indications for a fret diagram" (if (not (null? barre-list)) - (let* ((details (chain-assoc-get 'fret-diagram-details props '())) - (string1 (caar barre-list)) + (let* ((string1 (caar barre-list)) (string2 (cadar barre-list)) (fret (caddar barre-list)) (top-fret (cadr fret-range)) (low-fret (car fret-range)) - (barre-type (chain-assoc-get 'barre-type details 'curved)) + (barre-type (chain-assoc-get 'barre-type props 'curved)) (scale-dot-radius (* size dot-radius)) (barre-vertical-offset 0.5) ; (barre-vertical-offset (chain-assoc-get 'barre-vertical-offset props 0.5)) ;; 2 is 1 for empty fret at bottom of figure + 1 for interval (top-fret - fret + 1) -- not an arbitrary constant (dot-center-y (* size - (- (+ 2 (- (cadr fret-range) fret)) dot-position))) + (- (+ 2 (- (cadr fret-range) fret)) dot-position))) (dot-center-fret-coordinate (+ (- fret low-fret) dot-position)) (barre-fret-coordinate (+ dot-center-fret-coordinate (* (- barre-vertical-offset 0.5) dot-radius))) (barre-start-string-coordinate (- string-count string1)) @@ -358,7 +359,7 @@ Line thickness is given by @var{th}, fret & string spacing by (if (eq? orientation 'normal) (ly:make-stencil (list 'draw-line (* size dot-radius) left dot-center-y right dot-center-y) (cons left right) - (cons (- dot-center-y scale-dot-radius) (+ dot-center-y scale-dot-radius))) + (cons (- dot-center-y scale-dot-radius) (+ dot-center-y scale-dot-radius))) (ly:make-stencil (list 'draw-line (* size dot-radius) (* size barre-fret-coordinate) (* size barre-start-string-coordinate) @@ -377,34 +378,35 @@ Line thickness is given by @var{th}, fret & string spacing by (cons left right)))))) (if (not (null? (cdr barre-list))) (ly:stencil-add barre-stencil - (draw-barre layout props string-count fret-range size finger-code + (draw-barre layout props string-count fret-range size finger-code dot-position dot-radius (cdr barre-list))) barre-stencil )))) - + (define (stepmag mag) "Calculate the font step necessary to get a desired magnification" (* 6 (/ (log mag) (log 2)))) (define (label-fret layout props string-count fret-range size orientation) "Label the base fret on a fret diagram" - (let* ((details (chain-assoc-get 'fret-diagram-details props '())) - (base-fret (car fret-range)) - (label-font-mag (chain-assoc-get 'fret-label-font-mag details 0.5)) - (label-vertical-offset (chain-assoc-get 'fret-label-vertical-offset details -0.2)) - (number-type (chain-assoc-get 'number-type details 'roman-lower)) + (let* ((base-fret (car fret-range)) +; (label-font-mag (chain-assoc-get 'label-font-mag props 0.7)) + (label-font-mag 0.5) +; (label-vertical-offset (chain-assoc-get 'fret-label-vertical-offset props -0.2)) + (label-vertical-offset -0.2) + (number-type (chain-assoc-get 'number-type props 'roman-lower)) (fret-count (+ (- (cadr fret-range) (car fret-range)) 1)) - (label-text + (label-text (cond - ((equal? number-type 'roman-lower) (fancy-format #f "~(~:@r~)" base-fret)) - ((equal? number-type 'roman-upper) (fancy-format #f "~:@r" base-fret)) - ((equal? 'arabic number-type) (fancy-format #f "~d" base-fret)) - (else (fancy-format #f "~(~:@r~)" base-fret))))) + ((equal? number-type 'roman-lower) (fancy-format #f "~(~:@r~)" base-fret)) + ((equal? number-type 'roman-upper) (fancy-format #f "~:@r" base-fret)) + ((equal? 'arabic number-type) (fancy-format #f "~d" base-fret)) + (else (fancy-format #f "~(~:@r~)" base-fret))))) (if (eq? orientation 'normal) (ly:stencil-translate-axis (sans-serif-stencil layout props (* size label-font-mag) label-text) (* size (+ fret-count label-vertical-offset)) Y) - (ly:stencil-translate-axis - (sans-serif-stencil layout props (* size label-font-mag) label-text) + (ly:stencil-translate-axis + (sans-serif-stencil layout props (* size label-font-mag) label-text) (* size (+ 1 label-vertical-offset)) X)))) (define-builtin-markup-command (fret-diagram-verbose layout props marking-list) @@ -428,11 +430,11 @@ Line thickness is given by @var{th}, fret & string spacing by \\markup \\fret-diagram-verbose #'((mute 6) (mute 5) (open 4) (place-fret 3 2) (place-fret 2 3) (place-fret 1 2)) -@end example +@end example @noindent produces a standard D@tie{}chord diagram without fingering indications. - + Possible elements in @var{marking-list}: @table @code @@ -456,77 +458,60 @@ changed by setting the value of the variable @var{dot-color}. If the variable @var{finger-code}. There is no limit to the number of fret indications per string. @end table" - (make-fret-diagram layout props marking-list)) - -(define (make-fret-diagram layout props marking-list) -" Make a fret diagram markup" - (let* ( - ; note: here we get items from props that are needed in this routine, or that are needed in more than one - ; of the procedures called from this routine. If they're only used in one of the sub-procedure, they're - ; obtained in that procedure - - (size (chain-assoc-get 'size props 1.0)) ; needed for everything -;TODO -- get string-count directly from length of stringTunings; requires FretDiagram engraver, which is not yet available -;TODO -- adjust padding for fret label? it appears to be too close to dots - (details (chain-assoc-get 'fret-diagram-details props '())) ; fret diagram details - (string-count (chain-assoc-get 'string-count details 6)) ; needed for everything - (fret-count (chain-assoc-get 'fret-count details 4)) ; needed for everything - (orientation (chain-assoc-get 'orientation details 'normal)) ; needed for everything - (finger-code (chain-assoc-get 'finger-code details 'none)) ; needed for both draw-dots and draw-barre + (let* (;; note: here we get items from props that are needed in this routine, or that are needed in more than one + ;; of the procedures called from this routine. If they're only used in one of the sub-procedure, they're + ;; obtained in that procedure + ;;TODO -- get string-count directly from length of stringTunings; requires FretDiagram engraver, which is not yet available + ;;TODO -- adjust padding for fret label? it appears to be too close to dots (default-dot-radius (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 if labeled - (dot-radius (chain-assoc-get 'dot-radius details default-dot-radius)) ; needed for both draw-dots and draw-barre - (dot-position (chain-assoc-get 'dot-position details default-dot-position)) ; needed for both draw-dots and draw-barre + (dot-radius (chain-assoc-get 'dot-radius props default-dot-radius)) ; needed for both draw-dots and draw-barre + (dot-position (chain-assoc-get 'dot-position props default-dot-position)) ; needed for both draw-dots and draw-barre (th (* (ly:output-def-lookup layout 'line-thickness) - (chain-assoc-get 'thickness props 0.5))) ; needed for both draw-frets and draw-strings - - (alignment (chain-assoc-get 'align-dir props -0.4)) ; needed only here - (xo-padding (* size (chain-assoc-get 'xo-padding details 0.2))) ; needed only here + thickness)) ; needed for both draw-frets and draw-strings + ;; (xo-padding (* th (chain-assoc-get 'padding props 2))) ; needed only here (label-space (* 0.25 size)) -; (xo-padding (* th size 5)) - (label-dir (chain-assoc-get 'label-dir details RIGHT)) + (xo-padding (* th size 5)) (parameters (fret-parse-marking-list marking-list fret-count)) (dot-list (cdr (assoc 'dot-list parameters))) (xo-list (cdr (assoc 'xo-list parameters))) (fret-range (cdr (assoc 'fret-range parameters))) (barre-list (cdr (assoc 'barre-list parameters))) (fret-diagram-stencil (ly:stencil-add - (draw-strings string-count fret-range th size orientation) - (draw-frets fret-range string-count th size orientation)))) - (if (not (null? barre-list)) - (set! fret-diagram-stencil (ly:stencil-add - (draw-barre layout props string-count fret-range size finger-code + (draw-strings string-count fret-range th size orientation) + (draw-frets layout props fret-range string-count th size orientation)))) + (if (not (null? barre-list)) + (set! fret-diagram-stencil (ly:stencil-add + (draw-barre layout props string-count fret-range size finger-code dot-position dot-radius barre-list orientation) fret-diagram-stencil))) (if (not (null? dot-list)) (set! fret-diagram-stencil (ly:stencil-add fret-diagram-stencil (draw-dots layout props string-count fret-count fret-range size finger-code - dot-position dot-radius th dot-list orientation)))) - (if (= (car fret-range) 1) - (set! fret-diagram-stencil - (if (eq? orientation 'normal) - (ly:stencil-combine-at-edge fret-diagram-stencil Y UP - (draw-thick-zero-fret props string-count th size orientation)) - (ly:stencil-combine-at-edge fret-diagram-stencil X LEFT - (draw-thick-zero-fret props string-count th size orientation))))) - (if (not (null? xo-list)) - (set! fret-diagram-stencil - (if (eq? orientation 'normal) - (ly:stencil-combine-at-edge fret-diagram-stencil Y UP - (draw-xo layout props string-count fret-range size xo-list orientation) xo-padding ) - (ly:stencil-combine-at-edge fret-diagram-stencil X LEFT - (draw-xo layout props string-count fret-range size xo-list orientation) xo-padding)))) - (if (> (car fret-range) 1) - (set! fret-diagram-stencil - (if (eq? orientation 'normal) - (ly:stencil-combine-at-edge fret-diagram-stencil X label-dir - (label-fret layout props string-count fret-range size orientation) label-space) - (ly:stencil-combine-at-edge fret-diagram-stencil Y label-dir - (label-fret layout props string-count fret-range size orientation) label-space)))) - - (ly:stencil-aligned-to fret-diagram-stencil X alignment) - )) + dot-position dot-radius th dot-list orientation)))) + (if (= (car fret-range) 1) + (set! fret-diagram-stencil + (if (eq? orientation 'normal) + (ly:stencil-combine-at-edge fret-diagram-stencil Y UP + (draw-thick-zero-fret props string-count th size orientation)) + (ly:stencil-combine-at-edge fret-diagram-stencil X LEFT + (draw-thick-zero-fret props string-count th size orientation))))) + (if (not (null? xo-list)) + (set! fret-diagram-stencil + (if (eq? orientation 'normal) + (ly:stencil-combine-at-edge fret-diagram-stencil Y UP + (draw-xo layout props string-count fret-range size xo-list orientation) xo-padding ) + (ly:stencil-combine-at-edge fret-diagram-stencil X LEFT + (draw-xo layout props string-count fret-range size xo-list orientation) xo-padding)))) + (if (> (car fret-range) 1) + (set! fret-diagram-stencil + (if (eq? orientation 'normal) + (ly:stencil-combine-at-edge fret-diagram-stencil X label-dir + (label-fret layout props string-count fret-range size orientation) label-space) + (ly:stencil-combine-at-edge fret-diagram-stencil Y label-dir + (label-fret layout props string-count fret-range size orientation) label-space)))) + (ly:stencil-aligned-to fret-diagram-stencil X align-dir))) (define-builtin-markup-command (fret-diagram layout props definition-string) (string?) @@ -543,7 +528,7 @@ for fret spacing 3/4 of staff space, D chord diagram Syntax rules for @var{definition-string}: @itemize @minus - + @item Diagram items are separated by semicolons. @@ -585,7 +570,7 @@ Default:@tie{}0.6. @item @code{c:}@var{string1}@code{-}@var{string2}@code{-}@var{fret} -- Include a barre mark from @var{string1} to @var{string2} on @var{fret}. - + @item @var{string}@code{-}@var{fret} -- Place a dot on @var{string} at @var{fret}. If @var{fret} is @samp{o}, @var{string} is identified as open. @@ -615,33 +600,31 @@ Note: There is no limit to the number of fret indications per string. (xo-list '()) (output-list '()) (new-props '()) - (details (chain-assoc-get 'fret-diagram-details props '())) - (details-alist (if (null? details) '() (car details))) (items (string-split definition-string #\;))) (let parse-item ((myitems items)) - (if (not (null? (cdr myitems))) + (if (not (null? (cdr myitems))) (let ((test-string (car myitems))) - (case (car (string->list (substring test-string 0 1))) + (case (car (string->list (substring test-string 0 1))) ((#\s) (let ((size (get-numeric-from-key test-string))) (set! new-props (acons 'size size new-props)))) ((#\f) (let* ((finger-code (get-numeric-from-key test-string)) (finger-id (case finger-code ((0) 'none) - ((1) 'in-dot) + ((1) 'in-dot) ((2) 'below-string)))) - (set! details-alist - (assoc-set! details-alist 'finger-code finger-id )))) + (set! new-props + (acons 'finger-code finger-id new-props)))) ((#\c) (set! output-list (cons-fret (cons 'barre (numerify (string-split (substring test-string 2) #\-))) output-list))) ((#\h) (let ((fret-count (get-numeric-from-key test-string))) - (set! details-alist (assoc-set! details-alist 'fret-count fret-count)))) + (set! new-props (acons 'fret-count fret-count new-props)))) ((#\w) (let ((string-count (get-numeric-from-key test-string))) - (set! details-alist (assoc-set! details-alist 'string-count string-count)))) - ((#\d) (let ((dot-size (get-numeric-from-key test-string))) - (set! details-alist (assoc-set! details-alist 'dot-radius dot-size)))) + (set! new-props (acons 'string-count string-count new-props)))) + ((#\d) (let ((dot-size (get-numeric-from-key test-string))) + (set! new-props (acons 'dot-radius dot-size new-props)))) ((#\p) (let ((dot-position (get-numeric-from-key test-string))) - (set! details-alist (assoc-set! details-alist 'dot-position dot-position)))) - (else + (set! new-props (acons 'dot-position dot-position new-props)))) + (else (let ((this-list (string-split test-string #\-))) (if (string->number (cadr this-list)) (set! output-list (cons-fret (cons 'place-fret (numerify this-list)) output-list)) @@ -649,8 +632,6 @@ Note: There is no limit to the number of fret indications per string. (set! output-list (cons-fret (list 'mute (string->number (car this-list))) output-list)) (set! output-list (cons-fret (list 'open (string->number (car this-list))) output-list))))))) (parse-item (cdr myitems))))) - ; add the modified details - (set! props `(((fret-diagram-details . (,details-alist))) . ,props)) (if (eq? new-props '()) `(,props . ,output-list) `(,(cons new-props props) . ,output-list)))) @@ -660,11 +641,11 @@ Note: There is no limit to the number of fret indications per string. (if (eq? old-list '()) (list new-value) (cons* new-value old-list))) - + (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) @@ -673,7 +654,7 @@ Note: There is no limit to the number of fret indications per string. (if numeric-value (cons* numeric-value (numerify (cdr mylist))) (cons* (car (string->list (car mylist))) (numerify (cdr mylist))))))) - + (define-builtin-markup-command (fret-diagram-terse layout props definition-string) (string?) fret-diagram @@ -683,7 +664,7 @@ Note: There is no limit to the number of fret indications per string. Here an example @example -\\markup \\fret-diagram-terse #\"x;x;o;2;3;2;\" +\\markup \\fret-diagram-terse #\"x;x;o;2;3;2;\" @end example @noindent @@ -693,8 +674,8 @@ Syntax rules for @var{definition-string}: @itemize @bullet -@item -Strings are terminated by semicolons; the number of semicolons +@item +Strings are terminated by semicolons; the number of semicolons is the number of strings in the diagram. @item @@ -729,15 +710,13 @@ with @code{-(} to start a barre and @code{-)} to end the barre. props, modified to include the string-count determined by the definition-string a fret-indication list with the appropriate values" ;TODO -- change syntax to fret\string-finger - (let* ((details (chain-assoc-get 'fret-diagram-details props '())) - (details-alist (if (null? details) '() (car details))) - (barre-start-list '()) + (let* ((barre-start-list '()) (output-list '()) (new-props '()) (items (string-split definition-string #\;)) (string-count (- (length items) 1))) (let parse-item ((myitems items)) - (if (not (null? (cdr myitems))) + (if (not (null? (cdr myitems))) (let* ((test-string (car myitems)) (current-string (- (length myitems) 1)) (indicators (string-split test-string #\ ))) @@ -754,7 +733,7 @@ with @code{-(} to start a barre and @code{-)} to end the barre. (if (equal? last-element ")") (let* ((this-barre (get-sub-list fret barre-start-list)) (insert-index (- (length this-barre) 1))) - (set! output-list (cons-fret (cons* 'barre (car this-barre) current-string (cdr this-barre)) + (set! output-list (cons-fret (cons* 'barre (car this-barre) current-string (cdr this-barre)) output-list)) (set! this-list (list-head this-list max-element-index)))) (if (number? fret) @@ -764,9 +743,9 @@ with @code{-(} to start a barre and @code{-)} to end the barre. (set! output-list (cons-fret (list 'open current-string) output-list)))) (parse-indicators (cdr myindicators))))) (parse-item (cdr myitems))))) - (set! details-alist (assoc-set! details-alist 'string-count string-count)) - (set! props `(((fret-diagram-details . (,details-alist))) . ,props)) - `(,props . ,output-list))) + (set! new-props (acons 'string-count string-count new-props)) + + `(,(cons new-props props) . ,output-list))) (define (drop-paren item-list) " drop a final parentheses from a fret indication list resulting from a terse string specification of barre." @@ -774,10 +753,10 @@ with @code{-(} to start a barre and @code{-)} to end the barre. (let* ((max-index (- (length item-list) 1)) (last-element (car (list-tail item-list max-index)))) (if (or (equal? last-element ")") (equal? last-element "(")) - (list-head item-list max-index) + (list-head item-list max-index) item-list)) item-list)) - + (define (get-sub-list value master-list) " Get a sub-list whose cadr is equal to @var{value} from @var{master-list}" (if (eq? master-list '()) -- 2.11.4.GIT