X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Ffret-diagrams.scm;h=6dda45292852bdc0937521eda8abb1286d343b91;hb=HEAD;hp=f2e7fb6db4d86275985a4617c806c770a41002c0;hpb=e18531db1f79fb685fbd16d6a2a67bf4b6c09915;p=lilypond.git diff --git a/scm/fret-diagrams.scm b/scm/fret-diagrams.scm index f2e7fb6db4..6dda452928 100644 --- a/scm/fret-diagrams.scm +++ b/scm/fret-diagrams.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 2004--2010 Carl D. Sorensen +;;;; Copyright (C) 2004--2015 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 @@ -15,16 +15,13 @@ ;;;; You should have received a copy of the GNU General Public License ;;;; along with LilyPond. If not, see . -; -; Utility functions -; -; +;; Utility functions (define (string-x-extent start-point end-point) "Return the x-extent of a string that goes from start-point to end-point." (let ((x1 (car start-point)) - (x2 (car end-point))) + (x2 (car end-point))) (if (> x1 x2) (cons x2 x1) (cons x1 x2)))) @@ -33,7 +30,7 @@ to end-point." "Return the y-extent of a string that goes from start-point to end-point." (let ((y1 (cdr start-point)) - (y2 (cdr end-point))) + (y2 (cdr end-point))) (if (> y1 y2) (cons y2 y1) (cons y1 y2)))) @@ -47,7 +44,15 @@ to end-point." (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)))) + (let* ((entry (substring keystring 2 (string-length keystring))) + (numeric-entry (string->number entry))) + ;; throw an error, if `entry' can't be transformed into a number + (if numeric-entry + numeric-entry + (ly:error + "Unhandled entry in fret-diagram \"~a\" in \"~a\"" + entry + keystring)))) (define (numerify mylist) "Convert string values to numeric or character" @@ -64,18 +69,72 @@ to end-point." (* 6 (/ (log mag) (log 2)))) (define (fret-count fret-range) - "Calculate the fret count for the diagram given the range of frets in the diagram." - (1+ (- (cdr fret-range) (car fret-range)))) + "Calculate the fret count for the diagram given the range of frets in the diagram." + (1+ (- (cdr fret-range) (car fret-range)))) + +(define (dot-has-color dot-settings) + "Return a color-name as symbol, if found in @var{dot-settings} otherwise @code{#f}" + (cond ((null? dot-settings) + #f) + ;; Don't bother the user with quote/unquote. + ;; We use the name-symbol for the color, looking up in 'x11-color-list' + ((member (car dot-settings) (map car x11-color-list)) + (car dot-settings)) + (else (dot-has-color (cdr dot-settings))))) + +(define (dot-is-inverted dot-settings) + "Return @code{'inverted}, if found in @var{dot-settings} otherwise @code{'()}" + (let ((inverted (member 'inverted dot-settings))) + (if inverted + (car inverted) + '()))) + +(define (dot-is-parenthesized dot-settings) + "Return @code{'parenthesized}, if found in @var{dot-settings} otherwise @code{'()}" + (let ((parenthesized (member 'parenthesized dot-settings))) + (if parenthesized + (car parenthesized) + '()))) + +;; If @code{'default-paren-color} is not set, the parenthesis will take their +;; color from the dot. +;; Setting @code{'default-paren-color} will result in taking the color from +;; `what-color', see below. +(define (default-paren-color dot-settings) + "Return @code{'default-paren-color}, if found in @var{dot-settings} otherwise @code{'()}" + (let ((default-color (member 'default-paren-color dot-settings))) + (if default-color + (car default-color) + '()))) (define (subtract-base-fret base-fret dot-list) "Subtract @var{base-fret} from every fret in @var{dot-list}" (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-number or markup + (if (and (not (null? (cddr this-list))) + (or (markup? (caddr this-list)) + (number? (caddr this-list)))) + (third this-list) + '()) + ;; inverted + (dot-is-inverted this-list) + ;; parenthesis + (dot-is-parenthesized this-list) + ;; color modifiers + ;; parenthesis + (default-paren-color this-list) + ;; dots + (let ((colored (dot-has-color this-list))) + (if colored + colored + '()))) (subtract-base-fret base-fret (cdr dot-list)))))) (define (drop-paren item-list) @@ -100,7 +159,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 @@ -120,57 +179,53 @@ found." (helper key alist-list (if (pair? default) (car default) #f))) -; -; Conversions between fret/string coordinate system and x-y coordinate -; system. -; -; Fret coordinates are measured down the fretboard from the nut, -; starting at 0. -; -; String coordinates are measured from the lowest string, starting at 0. -; -; The x-y origin is at the intersection of the nut and the lowest string. -; -; X coordinates are positive to the right. -; Y coordinates are positive up. -; +;; Conversions between fret/string coordinate system and x-y coordinate +;; system. +;; +;; Fret coordinates are measured down the fretboard from the nut, +;; starting at 0. +;; +;; String coordinates are measured from the lowest string, starting at 0. +;; +;; The x-y origin is at the intersection of the nut and the lowest string. +;; +;; X coordinates are positive to the right. +;; Y coordinates are positive up. (define (negate-extent extent) "Return the extent in an axis opposite to the axis of @code{extent}." - (cons (- (cdr extent)) (- (car extent)))) + (cons (- (cdr extent)) (- (car extent)))) (define (stencil-fretboard-extent stencil fretboard-axis orientation) "Return the extent of @code{stencil} in the @code{fretboard-axis} direction." (if (eq? fretboard-axis 'fret) - (cond ((eq? orientation 'landscape) - (ly:stencil-extent stencil X)) - ((eq? orientation 'opposing-landscape) - (negate-extent (ly:stencil-extent stencil X))) - (else - (negate-extent (ly:stencil-extent stencil Y)))) - ; else -- eq? fretboard-axis 'string - (cond ((eq? orientation 'landscape) - (ly:stencil-extent stencil Y)) - ((eq? orientation 'opposing-landscape) - (negate-extent (ly:stencil-extent stencil Y))) - (else - (ly:stencil-extent stencil Y))))) + (cond ((eq? orientation 'landscape) + (ly:stencil-extent stencil X)) + ((eq? orientation 'opposing-landscape) + (negate-extent (ly:stencil-extent stencil X))) + (else + (negate-extent (ly:stencil-extent stencil Y)))) + ;; else -- eq? fretboard-axis 'string + (cond ((eq? orientation 'landscape) + (ly:stencil-extent stencil Y)) + ((eq? orientation 'opposing-landscape) + (negate-extent (ly:stencil-extent stencil Y))) + (else + (ly:stencil-extent stencil Y))))) (define (stencil-fretboard-offset stencil fretboard-axis orientation) - "Return a the stencil coordinates of the center of @code{stencil} + "Return a the stencil coordinates of the center of @code{stencil} in the @code{fretboard-axis} direction." (* 0.5 (interval-length - (stencil-fretboard-extent stencil fretboard-axis orientation)))) + (stencil-fretboard-extent stencil fretboard-axis orientation)))) (define (string-thickness string thickness-factor) (expt (1+ thickness-factor) (1- string))) -; -; Functions that create stencils used in the fret diagram -; +;; Functions that create stencils used in the fret diagram (define (sans-serif-stencil layout props mag text) "Create a stencil in sans-serif font based on @var{layout} and @var{props} @@ -181,16 +236,11 @@ with magnification @var{mag} of the string @var{text}." (prepend-alist-chain 'font-family 'sans props)))) (interpret-markup layout my-props text))) -;; -;; ;; markup commands and associated functions -;; -;; -;; (define (fret-parse-marking-list marking-list my-fret-count) - "Parse a fret-diagram-verbose marking list into component sublists" - (let* ((fret-range (cons 1 my-fret-count)) + "Parse a fret-diagram-verbose marking list into component sublists" + (let* ((fret-range (cons 1 my-fret-count)) (capo-fret 0) (barre-list '()) (dot-list '()) @@ -203,9 +253,13 @@ with magnification @var{mag} of the string @var{text}." ((or (eq? my-code 'open)(eq? my-code 'mute)) (set! xo-list (cons* my-item xo-list))) ((eq? my-code 'barre) - (set! barre-list (cons* (cdr my-item) barre-list))) + (if (every number? (cdr my-item)) + (set! barre-list (cons* (cdr my-item) barre-list)) + (ly:error + "barre-indications should contain only numbers: ~a" + (cdr my-item)))) ((eq? my-code 'capo) - (set! capo-fret (cadr my-item))) + (set! capo-fret (cadr my-item))) ((eq? my-code 'place-fret) (set! dot-list (cons* (cdr my-item) dot-list)))) (parse-item (cdr mylist))))) @@ -219,13 +273,17 @@ with magnification @var{mag} of the string @var{text}." (if (> fretval maxfret) (set! maxfret fretval)) (if (< fretval minfret) (set! minfret fretval)) (updatemax (cdr fret-list))))) - (if (> maxfret my-fret-count) + ;; take frets of 'barre-settings into account + (if (not (null? barre-list)) + (set! minfret (apply min minfret (map last barre-list)))) + (if (or (> maxfret my-fret-count) (> capo-fret 1)) (set! fret-range (cons minfret (let ((upfret (- (+ minfret my-fret-count) 1))) (if (> maxfret upfret) maxfret upfret))))) - (set! capo-fret (1+ (- capo-fret minfret))) - ; subtract fret from dots + (if (not (zero? (apply min capo-fret (map cadr dot-list)))) + (set! capo-fret (1+ (- capo-fret minfret)))) + ;; subtract fret from dots (set! dot-list (subtract-base-fret (- (car fret-range) 1) dot-list))) (acons 'fret-range fret-range (acons 'barre-list barre-list @@ -236,47 +294,51 @@ with magnification @var{mag} of the string @var{text}." (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 + ;; 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; - ; from FretBoard engraver, but not from markup call + ;;TODO -- get string-count directly from length of stringTunings; + ;; from FretBoard engraver, but not from markup call (details (merge-details 'fret-diagram-details props '())) + (fret-distance + (assoc-get 'fret-distance details 1.0)) + (string-distance + (assoc-get 'string-distance details 1.0)) (string-count - (assoc-get 'string-count details 6)) ; needed for everything + (assoc-get 'string-count details 6)) ;; needed for everything (my-fret-count - (assoc-get 'fret-count details 4)) ; needed for everything + (assoc-get 'fret-count details 4)) ;; needed for everything (orientation - (assoc-get 'orientation details 'normal)) ; needed for everything + (assoc-get 'orientation details 'normal)) ;; needed for everything (finger-code - (assoc-get - 'finger-code details 'none)) ; needed for draw-dots and draw-barre + (assoc-get + 'finger-code details 'none)) ;; needed for draw-dots and draw-barre (default-dot-radius - (if (eq? finger-code 'in-dot) 0.425 0.25)) ; bigger dots if labeled + (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 (dot-radius - (assoc-get - 'dot-radius details default-dot-radius)) ; needed for draw-dots - ; and draw-barre + (assoc-get + 'dot-radius details default-dot-radius)) + ;; needed for draw-dots and draw-barre (dot-position - (assoc-get - 'dot-position details default-dot-position)) ; needed for - ; draw-dots and draw-barre + (assoc-get + '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 + (* (ly:output-def-lookup layout 'line-thickness) + (chain-assoc-get 'thickness props 0.5))) + ;; needed for draw-frets and draw-strings (sth (* size th)) (thickness-factor (assoc-get 'string-thickness-factor details 0)) + (paren-padding (assoc-get 'paren-padding details 0.05)) (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 + (chain-assoc-get 'align-dir props -0.4)) ;; 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 (assoc-get 'dot-list parameters)) @@ -285,9 +347,9 @@ with magnification @var{mag} of the string @var{text}." (my-fret-count (fret-count fret-range)) (barre-list (assoc-get 'barre-list parameters)) (barre-type - (assoc-get 'barre-type details 'curved)) + (assoc-get 'barre-type details 'curved)) (fret-diagram-stencil '())) - ; + ;; Here are the fret diagram helper functions that depend on the ;; fret diagram parameters. The functions are here because the ;; diagram parameters are part of the lexical scope here. @@ -296,24 +358,24 @@ with magnification @var{mag} of the string @var{text}." "Return a pair @code{(x-coordinate . y-coordinate)} in stencil coordinate system." (cond - ((eq? orientation 'landscape) - (cons fret-coordinate - (- string-coordinate (1- string-count)))) - ((eq? orientation 'opposing-landscape) - (cons (- fret-coordinate) (- string-coordinate))) - (else - (cons string-coordinate (- fret-coordinate))))) + ((eq? orientation 'landscape) + (cons fret-coordinate + (- string-coordinate (1- string-count)))) + ((eq? orientation 'opposing-landscape) + (cons (- fret-coordinate) (- string-coordinate))) + (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))))) + ((eq? orientation 'landscape) + (cons fret-offset (- string-offset))) + ((eq? orientation 'opposing-landscape) + (cons (- fret-offset) string-offset)) + (else + (cons string-offset (- fret-offset))))) @@ -323,56 +385,57 @@ with magnification @var{mag} of the string @var{text}." string coordinate @var{start} to string-coordinate @var{stop} with a baseline at fret coordinate @var{base}, a height of @var{height}, and a half thickness of @var{half-thickness}." - (let* ((width (+ (- stop start) 1)) - (cp-left-width (+ (* width half-thickness) start)) - (cp-right-width (- stop (* width half-thickness))) - (bottom-control-point-height - (- base (- height half-thickness))) - (top-control-point-height - (- base height)) - (left-end-point - (stencil-coordinates base start)) - (right-end-point - (stencil-coordinates base stop)) - (left-upper-control-point - (stencil-coordinates + (let* ((width (+ (- stop start) 1)) + (cp-left-width (+ (* width half-thickness) start)) + (cp-right-width (- stop (* width half-thickness))) + (bottom-control-point-height + (- base (- height half-thickness))) + (top-control-point-height + (- base height)) + (left-end-point + (stencil-coordinates base start)) + (right-end-point + (stencil-coordinates base stop)) + (left-upper-control-point + (stencil-coordinates top-control-point-height cp-left-width)) - (left-lower-control-point - (stencil-coordinates + (left-lower-control-point + (stencil-coordinates bottom-control-point-height cp-left-width)) - (right-upper-control-point - (stencil-coordinates + (right-upper-control-point + (stencil-coordinates top-control-point-height cp-right-width)) - (right-lower-control-point - (stencil-coordinates + (right-lower-control-point + (stencil-coordinates bottom-control-point-height cp-right-width))) - ; order of bezier control 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 left-lower-control-point - right-lower-control-point - right-end-point - left-end-point - right-upper-control-point - left-upper-control-point - left-end-point - right-end-point))) + + ;; order of bezier control points is: + ;; left cp low, left cp low, right cp low, right end low + ;; right cp high, left cp high + + (list + left-end-point + left-lower-control-point + right-lower-control-point + right-end-point + + right-upper-control-point + left-upper-control-point))) (define (draw-strings) "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)) - (string-stencil (car x)) - (ly:stencil-add (string-stencil (car x)) - (helper (cdr x))))) + (ly:stencil-add + (string-stencil (car x)) + (helper (cdr x))))) - (let* ( (string-list (map 1+ (iota string-count)))) + (let* ((string-list (map 1+ (iota string-count)))) (helper string-list))) (define (string-stencil string) @@ -380,17 +443,19 @@ Line thickness is given by @var{th}, fret & string spacing by overall parameters." (let* ((string-coordinate (- string-count string)) (current-string-thickness - (* th size (string-thickness string thickness-factor))) + (* th size (string-thickness string thickness-factor))) (fret-half-thickness (* size th 0.5)) (half-string (* current-string-thickness 0.5)) (start-coordinates - (stencil-coordinates - (- fret-half-thickness) - (- (* size string-coordinate) half-string))) + (stencil-coordinates + (- fret-half-thickness) + (- (* size string-distance string-coordinate) half-string))) (end-coordinates - (stencil-coordinates - (+ fret-half-thickness (* size (1+ (fret-count fret-range)))) - (+ half-string (* size string-coordinate))))) + (stencil-coordinates + (+ fret-half-thickness + (* size fret-distance (1+ (fret-count fret-range)))) + (+ half-string + (* size string-distance string-coordinate))))) (ly:round-filled-box (string-x-extent start-coordinates end-coordinates) (string-y-extent start-coordinates end-coordinates) @@ -400,457 +465,551 @@ 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)) - (ly:stencil-add (fret-stencil (car x)) - (helper (cdr x))))) + (ly:stencil-add + (fret-stencil (car x)) + (helper (cdr x))))) (let ((fret-list (iota (1+ my-fret-count)))) (helper fret-list))) - (define (fret-stencil fret) - "Make a stencil for @code{fret}, given the + (define (fret-stencil fret) + "Make a stencil for @code{fret}, given the fret-diagram overall parameters." - (let* ((low-string-half-thickness - (* 0.5 - size - th - (string-thickness string-count thickness-factor))) - (fret-half-thickness (* 0.5 size th)) - (start-coordinates - (stencil-coordinates - (* size fret) - (- fret-half-thickness low-string-half-thickness))) - (end-coordinates - (stencil-coordinates - (* size fret) - (* size (1- string-count))))) - (make-line-stencil - (* size th) - (car start-coordinates) (cdr start-coordinates) - (car end-coordinates) (cdr end-coordinates)))) - - (define (draw-barre barre-list) - "Create barre indications for a fret diagram" - (if (not (null? barre-list)) - (let* ((string1 (caar barre-list)) - (string2 (cadar barre-list)) - (barre-fret (caddar barre-list)) - (top-fret (cdr fret-range)) - (low-fret (car fret-range)) - (fret (1+ (- barre-fret low-fret))) - (barre-vertical-offset 0.5) - (dot-center-fret-coordinate (+ (1- fret) dot-position)) - (barre-fret-coordinate + (let* ((low-string-half-thickness + (* 0.5 + size + th + (string-thickness string-count thickness-factor))) + (fret-half-thickness (* 0.5 size th)) + (start-coordinates + (stencil-coordinates + (* fret-distance size fret) + (- fret-half-thickness low-string-half-thickness))) + (end-coordinates + (stencil-coordinates + (* fret-distance size fret) + (* size string-distance (1- string-count))))) + (make-line-stencil + (* size th) + (car start-coordinates) (cdr start-coordinates) + (car end-coordinates) (cdr end-coordinates)))) + + (define (draw-barre barre-list) + "Create barre indications for a fret diagram" + (if (not (null? barre-list)) + (let* ((string1 (caar barre-list)) + (string2 (cadar barre-list)) + (barre-fret (caddar barre-list)) + (top-fret (cdr fret-range)) + (low-fret (car fret-range)) + (fret (1+ (- barre-fret low-fret))) + (barre-vertical-offset 0.5) + (dot-center-fret-coordinate (+ (1- fret) dot-position)) + (barre-fret-coordinate (+ dot-center-fret-coordinate (* (- barre-vertical-offset 0.5) dot-radius))) - (barre-start-string-coordinate (- string-count string1)) - (barre-end-string-coordinate (- string-count string2)) - (scale-dot-radius (* size dot-radius)) - (barre-type (assoc-get 'barre-type details 'curved)) - (barre-stencil + (barre-start-string-coordinate (- string-count string1)) + (barre-end-string-coordinate (- string-count string2)) + (scale-dot-radius (* size dot-radius)) + (barre-type (assoc-get 'barre-type details 'curved)) + (barre-stencil (cond - ((eq? barre-type 'straight) - (make-straight-barre-stencil - barre-fret-coordinate - barre-start-string-coordinate - barre-end-string-coordinate - scale-dot-radius)) - ((eq? barre-type 'curved) - (make-curved-barre-stencil - barre-fret-coordinate - barre-start-string-coordinate - barre-end-string-coordinate - scale-dot-radius))))) - (if (not (null? (cdr barre-list))) - (ly:stencil-add - barre-stencil - (draw-barre (cdr barre-list))) - barre-stencil )))) - - (define (make-straight-barre-stencil - fret-coordinate - start-string-coordinate - end-string-coordinate - half-thickness) - "Create a straight barre stencil." - (let ((start-point - (stencil-coordinates - (* size fret-coordinate) - (* size start-string-coordinate))) - (end-point - (stencil-coordinates - (* size fret-coordinate) - (* size end-string-coordinate)))) - (make-line-stencil - half-thickness - (car start-point) - (cdr start-point) - (car end-point) - (cdr end-point)))) - - (define (make-curved-barre-stencil - fret-coordinate - start-string-coordinate - end-string-coordinate - half-thickness) - "Create a curved barre stencil." - (let* ((bezier-thick 0.1) - (bezier-height 0.5) - (bezier-list - (make-bezier-sandwich-list - (* size start-string-coordinate) - (* size end-string-coordinate) - (* size fret-coordinate) - (* size bezier-height) - (* size bezier-thick))) - (box-lower-left - (stencil-coordinates - (+ (* size fret-coordinate) half-thickness) - (- (* size start-string-coordinate) half-thickness))) - (box-upper-right - (stencil-coordinates - (- (* size fret-coordinate) - (* size bezier-height) - half-thickness) - (+ (* size end-string-coordinate) half-thickness))) - (x-extent (cons (car box-lower-left) (car box-upper-right))) - (y-extent (cons (cdr box-lower-left) (cdr box-upper-right)))) - (ly:make-stencil - (list 'bezier-sandwich - `(quote ,bezier-list) - (* size bezier-thick)) - x-extent - y-extent))) - - (define (draw-dots dot-list) - "Make dots for fret diagram." - - (let* ( (scale-dot-radius (* size dot-radius)) + ((eq? barre-type 'straight) + (make-straight-barre-stencil + barre-fret-coordinate + barre-start-string-coordinate + barre-end-string-coordinate + scale-dot-radius)) + ((eq? barre-type 'curved) + (make-curved-barre-stencil + barre-fret-coordinate + barre-start-string-coordinate + barre-end-string-coordinate + scale-dot-radius))))) + (if (not (null? (cdr barre-list))) + (ly:stencil-add + barre-stencil + (draw-barre (cdr barre-list))) + barre-stencil )))) + + (define (make-straight-barre-stencil + fret-coordinate + start-string-coordinate + end-string-coordinate + half-thickness) + "Create a straight barre stencil." + (let ((start-point + (stencil-coordinates + (* size fret-distance fret-coordinate) + (* size string-distance start-string-coordinate))) + (end-point + (stencil-coordinates + (* size fret-distance fret-coordinate) + (* size string-distance end-string-coordinate)))) + (make-line-stencil + half-thickness + (car start-point) + (cdr start-point) + (car end-point) + (cdr end-point)))) + + (define (make-curved-barre-stencil + fret-coordinate + start-string-coordinate + end-string-coordinate + half-thickness) + "Create a curved barre stencil." + (let* ((bezier-thick 0.1) + (bezier-height 0.5) + (bezier-list + (make-bezier-sandwich-list + (* size string-distance start-string-coordinate) + (* size string-distance end-string-coordinate) + (* size fret-distance fret-coordinate) + (* size bezier-height) + (* size bezier-thick)))) + (make-bezier-sandwich-stencil + bezier-list + (* size bezier-thick)))) + + (define (draw-dots dot-list) + "Make dots for fret diagram." + + (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)) (finger-label-padding 0.3) (dot-label-font-mag - (* scale-dot-radius - (assoc-get 'dot-label-font-mag details 1.0))) + (* scale-dot-radius + (assoc-get 'dot-label-font-mag details 1.0))) (string-label-font-mag - (* size - (assoc-get - 'string-label-font-mag details - (cond ((or (eq? orientation 'landscape) - (eq? orientation 'opposing-landscape)) - 0.5) - (else 0.6))))) + (* size + (assoc-get + 'string-label-font-mag details + (cond ((or (eq? orientation 'landscape) + (eq? orientation 'opposing-landscape)) + 0.5) + (else 0.6))))) (mypair (car dot-list)) (restlist (cdr dot-list)) (string (car mypair)) (fret (cadr mypair)) - (fret-coordinate (* size (+ (1- fret) dot-position))) - (string-coordinate (* size (- string-count string))) + (fret-coordinate + (* size fret-distance (+ (1- fret) dot-position))) + (string-coordinate + (* size string-distance (- string-count string))) (dot-coordinates - (stencil-coordinates fret-coordinate string-coordinate)) + (stencil-coordinates fret-coordinate string-coordinate)) (extent (cons (- scale-dot-radius) scale-dot-radius)) (finger (caddr mypair)) (finger (if (number? finger) (number->string finger) finger)) - (dot-stencil (if (eq? dot-color 'white) - (ly:stencil-add - (make-circle-stencil - scale-dot-radius scale-dot-thick #t) - (ly:stencil-in-color - (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))) + (parenthesized + (if (not (null? (dot-is-parenthesized mypair))) + (dot-is-parenthesized mypair) + #f)) + (parenthesis-color + (if (not (null? (default-paren-color mypair))) + (default-paren-color mypair) + #f)) + (inverted + (if (not (null? (dot-is-inverted mypair))) + (dot-is-inverted mypair) + #f)) + (dot-color-is-white? + (or inverted + (and (eq? default-dot-color 'white) (not inverted)))) + (what-color + (x11-color + (cond ((and inverted + (not (dot-has-color mypair)) + (not (eq? default-dot-color 'white))) + (or default-dot-color 'black)) + (dot-color-is-white? + (or (dot-has-color mypair) 'black)) + (else + (or (dot-has-color mypair) + default-dot-color + 'black))))) + (inverted-stil + (lambda (color) + (ly:stencil-add + (stencil-with-color + (make-circle-stencil + scale-dot-radius scale-dot-thick #t) + color) + (stencil-with-color + (make-circle-stencil + (- scale-dot-radius (* 0.5 scale-dot-thick)) + 0 #t) + (x11-color 'white))))) + (dot-stencil + (if dot-color-is-white? + (inverted-stil what-color) + (stencil-with-color + (make-circle-stencil + scale-dot-radius scale-dot-thick #t) + what-color))) + (par-dot-stencil + (let ((paren-color + (if (and parenthesis-color + (not (eq? default-dot-color 'white))) + (x11-color (or default-dot-color 'black)) + what-color))) + (stencil-with-color + (parenthesize-stencil + dot-stencil ;; stencil + (* size th 0.75) ;; half-thickness + (* 0.15 size) ;;width + 0 ;; angularity + paren-padding ;; padding + ) + paren-color))) + (final-dot-stencil + (if parenthesized + par-dot-stencil + dot-stencil)) (positioned-dot - (ly:stencil-translate dot-stencil dot-coordinates)) + (ly:stencil-translate final-dot-stencil dot-coordinates)) (labeled-dot-stencil - (cond - ((or (eq? finger '())(eq? finger-code 'none)) - positioned-dot) - ((eq? finger-code 'in-dot) - (let ((finger-label - (centered-stencil - (sans-serif-stencil - layout props dot-label-font-mag finger)))) - (ly:stencil-translate - (ly:stencil-add - dot-stencil - (if (eq? dot-color 'white) - finger-label - (ly:stencil-in-color finger-label 1 1 1))) - dot-coordinates))) - ((eq? finger-code 'below-string) - (let* ((label-stencil - (centered-stencil + (cond + ((or (eq? finger '())(eq? finger-code 'none)) + positioned-dot) + ((eq? finger-code 'in-dot) + (let* ((finger-stil + (if (not (null? finger)) (sans-serif-stencil - layout props string-label-font-mag - finger))) - (label-fret-offset - (stencil-fretboard-offset - label-stencil 'fret orientation)) - (label-fret-coordinate - (+ (* size - (+ 1 my-fret-count finger-label-padding)) - label-fret-offset)) - (label-string-coordinate string-coordinate) - (label-translation - (stencil-coordinates - label-fret-coordinate - label-string-coordinate))) - (ly:stencil-add - positioned-dot - (ly:stencil-translate - label-stencil - label-translation)))) - (else ;unknown finger-code - positioned-dot)))) - (if (null? restlist) - labeled-dot-stencil - (ly:stencil-add + layout props dot-label-font-mag finger) + empty-stencil)) + (finger-stil-length + (interval-length (ly:stencil-extent finger-stil X))) + (finger-stil-height + (interval-length (ly:stencil-extent finger-stil Y))) + (dot-stencil-radius + (/ (interval-length (ly:stencil-extent dot-stencil Y)) + 2)) + (scale-factor + (/ dot-stencil-radius + ;; Calculate the radius of the circle through the + ;; corners of the box containing the finger-stil. + ;; Give it a little padding. The value, (* 2 th), + ;; is my choice + (+ + (sqrt + (+ (expt (/ finger-stil-length 2) 2) + (expt (/ finger-stil-height 2) 2))) + (* 2 th)))) + (finger-label + (centered-stencil + (ly:stencil-scale + (sans-serif-stencil + layout props + dot-label-font-mag + finger) + scale-factor scale-factor)))) + (ly:stencil-translate + (ly:stencil-add + final-dot-stencil + (if dot-color-is-white? + (stencil-with-color + finger-label + what-color) + (stencil-with-color finger-label white))) + dot-coordinates))) + ((eq? finger-code 'below-string) + (let* ((label-stencil + (centered-stencil + (sans-serif-stencil + layout props string-label-font-mag + finger))) + (label-fret-offset + (stencil-fretboard-offset + label-stencil 'fret orientation)) + (label-fret-coordinate + ;; (1) Move the below-string-finger-codes to the bottom + ;; edge of the string, i.e. + ;; (* (1+ my-fret-count) fret-distance) + ;; (2) add `finger-label-padding' (a hardcoded + ;; correction-value to get a bit default padding). + ;; TODO: make it a property? + ;; (3) scale this with `size' + ;; (4) add `label-fret-offset', to get the final + ;; padding + (+ + (* size + (+ (* (1+ my-fret-count) fret-distance) + finger-label-padding)) + label-fret-offset)) + (label-string-coordinate string-coordinate) + (label-translation + (stencil-coordinates + label-fret-coordinate + label-string-coordinate))) + (ly:stencil-add + positioned-dot + (ly:stencil-translate + label-stencil + label-translation)))) + (else ;unknown finger-code + positioned-dot)))) + (if (null? restlist) + labeled-dot-stencil + (ly:stencil-add (draw-dots restlist) labeled-dot-stencil)))) - (define (draw-thick-zero-fret) - "Draw a thick zeroth fret for a fret diagram whose base fret is 1." - (let* ((half-lowest-string-thickness - (* 0.5 th (string-thickness string-count thickness-factor))) - (half-thick (* 0.5 sth)) - (top-fret-thick - (* sth (assoc-get 'top-fret-thickness details 3.0))) - (start-string-coordinate (- half-lowest-string-thickness)) - (end-string-coordinate (+ (* size (1- string-count)) half-thick)) - (start-fret-coordinate half-thick) - (end-fret-coordinate (- half-thick top-fret-thick)) - (lower-left - (stencil-coordinates - start-fret-coordinate start-string-coordinate)) - (upper-right - (stencil-coordinates - end-fret-coordinate end-string-coordinate))) - (ly:round-filled-box - (cons (car lower-left) (car upper-right)) - (cons (cdr lower-left) (cdr upper-right)) - sth))) - - (define (draw-xo xo-list) - "Put open and mute string indications on diagram, as contained in + (define (draw-thick-zero-fret) + "Draw a thick zeroth fret for a fret diagram whose base fret is 1." + (let* ((half-lowest-string-thickness + (* 0.5 th (string-thickness string-count thickness-factor))) + (half-thick (* 0.5 sth)) + (top-fret-thick + (* sth (assoc-get 'top-fret-thickness details 3.0))) + (start-string-coordinate (- half-lowest-string-thickness)) + (end-string-coordinate + (+ (* size string-distance (1- string-count)) half-thick)) + (start-fret-coordinate half-thick) + (end-fret-coordinate (- half-thick top-fret-thick)) + (lower-left + (stencil-coordinates + start-fret-coordinate start-string-coordinate)) + (upper-right + (stencil-coordinates + end-fret-coordinate end-string-coordinate))) + (ly:round-filled-box + ;; Put limits in order, or else the intervals are considered empty + (ordered-cons (car lower-left) (car upper-right)) + (ordered-cons (cdr lower-left) (cdr upper-right)) + sth))) + + (define (draw-xo xo-list) + "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 - (cond ((or (eq? orientation 'landscape) - (eq? orientation 'opposing-landscape)) - 0.4) - (else 0.4))))) - (mypair (car xo-list)) - (restlist (cdr xo-list)) - (glyph-string (if (eq? (car mypair) 'mute) - (assoc-get 'mute-string details "X") - (assoc-get 'open-string details "O"))) - (glyph-string-coordinate (* (- string-count (cadr mypair)) size)) - (glyph-stencil - (centered-stencil - (sans-serif-stencil - layout props (* size xo-font-mag) glyph-string))) - (glyph-stencil-coordinates - (stencil-coordinates 0 glyph-string-coordinate)) - (positioned-glyph - (ly:stencil-translate - glyph-stencil - glyph-stencil-coordinates))) - (if (null? restlist) - positioned-glyph - (ly:stencil-add + (let* ((xo-font-mag + (assoc-get 'xo-font-magnification details + (cond ((or (eq? orientation 'landscape) + (eq? orientation 'opposing-landscape)) + 0.4) + (else 0.4)))) + (mypair (car xo-list)) + (restlist (cdr xo-list)) + (glyph-string (if (eq? (car mypair) 'mute) + (assoc-get 'mute-string details "X") + (assoc-get 'open-string details "O"))) + (glyph-string-coordinate + (* (- string-count (cadr mypair)) string-distance size)) + (glyph-stencil + (centered-stencil + (sans-serif-stencil + layout props (* size xo-font-mag) glyph-string))) + (glyph-stencil-coordinates + (stencil-coordinates 0 glyph-string-coordinate)) + (positioned-glyph + (ly:stencil-translate + glyph-stencil + glyph-stencil-coordinates))) + (if (null? restlist) + positioned-glyph + (ly:stencil-add positioned-glyph (draw-xo restlist))))) - (define (draw-capo fret) - "Draw a capo indicator across the full width of the fret-board + (define (draw-capo fret) + "Draw a capo indicator across the full width of the fret-board at @var{fret}." - (let* ((capo-thick - (* size (assoc-get 'capo-thickness details 0.5))) - (half-thick (* capo-thick 0.5)) - (last-string-position 0) - (first-string-position (* size (- string-count 1))) - (fret-position ( * size (1- (+ dot-position fret)))) - (start-point - (stencil-coordinates - fret-position - first-string-position)) - (end-point - (stencil-coordinates - fret-position - last-string-position))) - (make-line-stencil - capo-thick - (car start-point) (cdr start-point) - (car end-point) (cdr end-point)))) - - (define (label-fret fret-range) - "Label the base fret on a fret diagram" - (let* ((base-fret (car fret-range)) - (label-font-mag (assoc-get 'fret-label-font-mag details 0.5)) - (label-space (* 0.5 size)) - (label-dir (assoc-get 'label-dir details RIGHT)) - (label-vertical-offset - (assoc-get 'fret-label-vertical-offset details 0)) - (number-type - (assoc-get 'number-type details 'roman-lower)) - (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)))) - (label-stencil - (centered-stencil - (sans-serif-stencil - layout props (* size label-font-mag) label-text))) - (label-half-width - (stencil-fretboard-offset - label-stencil - 'string - orientation)) - (label-outside-diagram (+ label-space label-half-width))) - (ly:stencil-translate - label-stencil + (let* ((capo-thick + (* size (assoc-get 'capo-thickness details 0.5))) + (half-thick (* capo-thick 0.5)) + (last-string-position 0) + (first-string-position (* size (- string-count 1))) + (fret-position (* size (1- (+ dot-position fret)))) + (start-point (stencil-coordinates - (1+ (* size label-vertical-offset)) - (if (eq? label-dir LEFT) - (- label-outside-diagram) - (+ (* size (1- string-count)) label-outside-diagram)))))) - - - ; Here is the body of make-fret-diagram - ; + (* fret-distance fret-position) + (* string-distance first-string-position))) + (end-point + (stencil-coordinates + (* fret-distance fret-position) + last-string-position))) + (make-line-stencil + capo-thick + (car start-point) (cdr start-point) + (car end-point) (cdr end-point)))) + + (define (label-fret fret-range) + "Label the base fret on a fret diagram" + (let* ((base-fret (car fret-range)) + (label-font-mag (assoc-get 'fret-label-font-mag details 0.5)) + (label-space (* 0.5 size)) + (label-dir (assoc-get 'label-dir details RIGHT)) + (label-vertical-offset + (assoc-get 'fret-label-vertical-offset details 0)) + (label-horizontal-offset + (assoc-get 'fret-label-horizontal-offset details 0)) + (number-type + (assoc-get 'number-type details 'roman-lower)) + (label-text + (number-format number-type base-fret + (assoc-get 'fret-label-custom-format + details "~a"))) + (label-stencil + (centered-stencil + (sans-serif-stencil + layout props (* size label-font-mag) label-text))) + (label-half-width + (stencil-fretboard-offset + label-stencil + 'string + orientation)) + (label-outside-diagram + (+ label-space + (* size label-horizontal-offset) + label-half-width))) + (ly:stencil-translate + label-stencil + (stencil-coordinates + (* size fret-distance (1+ label-vertical-offset)) + (if (eqv? label-dir LEFT) + (- label-outside-diagram) + (+ (* size string-distance (1- string-count)) + label-outside-diagram)))))) + + ;; Here is the body of make-fret-diagram (set! fret-diagram-stencil - (ly:stencil-add (draw-strings) (draw-frets))) + (ly:stencil-add (draw-strings) (draw-frets))) (if (and (not (null? barre-list)) (not (eq? 'none barre-type))) - (set! fret-diagram-stencil - (ly:stencil-add - (draw-barre barre-list) - fret-diagram-stencil))) + (set! fret-diagram-stencil + (ly:stencil-add + (draw-barre barre-list) + fret-diagram-stencil))) (if (not (null? dot-list)) - (set! fret-diagram-stencil - (ly:stencil-add - fret-diagram-stencil - (draw-dots dot-list)))) + (set! fret-diagram-stencil + (ly:stencil-add + fret-diagram-stencil + (draw-dots dot-list)))) (if (= (car fret-range) 1) - (set! fret-diagram-stencil - (ly:stencil-add - fret-diagram-stencil - (draw-thick-zero-fret)))) + (set! fret-diagram-stencil + (ly:stencil-add + fret-diagram-stencil + (draw-thick-zero-fret)))) (if (not (null? xo-list)) - (let* ((diagram-fret-top - (car (stencil-fretboard-extent + (let* ((diagram-fret-top + (car (stencil-fretboard-extent fret-diagram-stencil 'fret orientation))) - (xo-stencil (draw-xo xo-list)) - (xo-fret-offset - (stencil-fretboard-offset + (xo-stencil (draw-xo xo-list)) + (xo-fret-offset + (stencil-fretboard-offset 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 - xo-stencil-offset))))) + (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 + xo-stencil-offset))))) (if (> capo-fret 0) - (set! fret-diagram-stencil - (ly:stencil-add - fret-diagram-stencil - (draw-capo capo-fret)))) + (set! fret-diagram-stencil + (ly:stencil-add + fret-diagram-stencil + (draw-capo capo-fret)))) (if (> (car fret-range) 1) - (set! fret-diagram-stencil - (ly:stencil-add - fret-diagram-stencil - (label-fret fret-range)))) + (set! fret-diagram-stencil + (ly:stencil-add + fret-diagram-stencil + (label-fret fret-range)))) (ly:stencil-aligned-to fret-diagram-stencil X alignment))) (define (fret-parse-definition-string props definition-string) - "Parse a fret diagram string and return a pair containing: + "Parse a fret diagram string and return a pair containing: @var{props}, modified as necessary by the definition-string a fret-indication list with the appropriate values" - (let* ((fret-count 4) - (string-count 6) - (fret-range (cons 1 fret-count)) - (barre-list '()) - (dot-list '()) - (xo-list '()) - (output-list '()) - (new-props '()) - (details (merge-details 'fret-diagram-details props '())) - (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))) - ((#\s) (let ((size (get-numeric-from-key test-string))) - (set! props (prepend-alist-chain 'size size props)))) - ((#\f) (let* ((finger-code (get-numeric-from-key test-string)) - (finger-id (case finger-code - ((0) 'none) - ((1) 'in-dot) - ((2) 'below-string)))) - (set! details - (acons 'finger-code finger-id details)))) - ((#\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 - (acons 'fret-count fret-count details)))) - ((#\w) (let ((string-count (get-numeric-from-key test-string))) - (set! details - (acons 'string-count string-count details)))) - ((#\d) (let ((dot-size (get-numeric-from-key test-string))) - (set! details - (acons 'dot-radius dot-size details)))) - ((#\p) (let ((dot-position (get-numeric-from-key test-string))) - (set! details - (acons 'dot-position dot-position details)))) - (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)) - (if (equal? (cadr this-list) "x" ) - (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 - (prepend-alist-chain 'fret-diagram-details details props)) - `(,props . ,output-list))) ;ugh -- hard-coded spell -- procedure better + (let* ((fret-count 4) + (string-count 6) + (fret-range (cons 1 fret-count)) + (barre-list '()) + (dot-list '()) + (xo-list '()) + (output-list '()) + (new-props '()) + (details (merge-details 'fret-diagram-details props '())) + ;; remove whitespace-characters from definition-string + (cleared-string (remove-whitespace definition-string)) + (items (string-split cleared-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))) + ((#\s) (let ((size (get-numeric-from-key test-string))) + (set! props (prepend-alist-chain 'size size props)))) + ((#\t) (let ((th (get-numeric-from-key test-string))) + (set! props (prepend-alist-chain 'thickness th props)))) + ((#\f) (let* ((finger-code (get-numeric-from-key test-string)) + (finger-id (case finger-code + ((0) 'none) + ((1) 'in-dot) + ((2) 'below-string)))) + (set! details + (acons 'finger-code finger-id details)))) + ((#\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 + (acons 'fret-count fret-count details)))) + ((#\w) (let ((string-count (get-numeric-from-key test-string))) + (set! details + (acons 'string-count string-count details)))) + ((#\d) (let ((dot-size (get-numeric-from-key test-string))) + (set! details + (acons 'dot-radius dot-size details)))) + ((#\p) (let ((dot-position (get-numeric-from-key test-string))) + (set! details + (acons 'dot-position dot-position details)))) + (else + (let* ((this-list (string-split test-string #\-)) + (fret-number (string->number (car this-list)))) + ;; If none of the above applies, `fret-number' needs to be a + ;; number. Throw an error, if not. + (if (not fret-number) + (ly:error + "Unhandled entry in fret-diagrams \"~a\" in \"~a\"" + (car this-list) + test-string)) + (if (string->number (cadr this-list)) + (set! output-list + (cons-fret + (cons 'place-fret (numerify this-list)) + output-list)) + (if (equal? (cadr this-list) "x" ) + (set! output-list + (cons-fret + (list 'mute fret-number) + output-list)) + (set! output-list + (cons-fret + (list 'open fret-number) + output-list))))))) + (parse-item (cdr myitems))))) + ;; add the modified details + (set! props + (prepend-alist-chain 'fret-diagram-details details props)) + `(,props . ,output-list))) ;ugh -- hard-coded spell -- procedure better (define-public (fret-parse-terse-definition-string props definition-string) @@ -859,7 +1018,7 @@ return a pair containing: @var{props}, modified to include the string-count determined by the definition-string, and a fret-indication list with the appropriate values" -;TODO -- change syntax to fret\string-finger + ;; TODO -- change syntax to fret\string-finger (let* ((details (merge-details 'fret-diagram-details props '())) (barre-start-list '()) @@ -932,9 +1091,9 @@ a fret-indication list with the appropriate values" (pair?) ; argument type (list, but use pair? for speed) #:category instrument-specific-markup ; markup type #:properties ((align-dir -0.4) ; properties and defaults - (size 1.0) - (fret-diagram-details) - (thickness 0.5)) + (size 1.0) + (fret-diagram-details) + (thickness 0.5)) "Make a fret diagram containing the symbols indicated in @var{marking-list}. For example, @@ -965,13 +1124,31 @@ to string @var{end-string} at fret @var{fret-number}. 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}] + [@var{color}] + [@code{'parenthesized} [@code{'default-paren-color}]]) 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}, +an optional color modifier @var{color-modifier}, an optional color +@var{color}, an optional parenthesis @code{'parenthesized} and an +optional paranthesis color @code{'default-paren-color}. 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} +or for a single dot by setting the value of @var{color}. The dot can +be parenthesized by adding @code{'parenthesized}. By default the +color for the parenthesis is taken from the dot. Adding +@code{'default-paren-color} will take the parenthesis-color from the +global @var{dot-color}, as a fall-back black will be used. +Setting @var{color-modifier} to @code{inverted} inverts the dot color +for a specific fingering. +The values for @var{string-number}, @var{fret-number}, and the optional +@var{finger} should be entered first in that order. +The order of the other optional arguments does not matter. +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. @@ -1009,8 +1186,9 @@ spaces). Default:@tie{}1. @item -@code{t:}@var{number} -- Set the line thickness (in staff spaces). -Default:@tie{}0.05. +@code{t:}@var{number} -- Set the line thickness (relative to normal +line thickness). +Default:@tie{}0.5. @item @code{h:}@var{number} -- Set the height of the diagram in frets. @@ -1095,13 +1273,13 @@ If there are multiple fret indicators desired on a string, they should be separated by spaces. @item -Fingerings are given by following the fret number with a @code{-}, +Fingerings are given by following the fret number with a @w{@code{-},} followed by the finger indicator, e.g. @samp{3-2} for playing the third fret with the second finger. @item Where a barre indicator is desired, follow the fret (or fingering) symbol -with @code{-(} to start a barre and @code{-)} to end the barre. +with @w{@code{-(}} to start a barre and @w{@code{-)}} to end the barre. @end itemize" ;; TODO -- change syntax to fret\string-finger @@ -1110,5 +1288,3 @@ with @code{-(} to start a barre and @code{-)} to end the barre. (fret-diagram-verbose-markup layout (car definition-list) (cdr definition-list)))) - -