scm/fret-diagrams.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 2004--2015 Carl D. Sorensen <c_sorensen@byu.edu>
   4 ;;;;
   5 ;;;; LilyPond is free software: you can redistribute it and/or modify
   6 ;;;; it under the terms of the GNU General Public License as published by
   7 ;;;; the Free Software Foundation, either version 3 of the License, or
   8 ;;;; (at your option) any later version.
   9 ;;;;
  10 ;;;; LilyPond is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;;;; GNU General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU General Public License
  16 ;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 ;;  Utility functions
  19
  20 (define (string-x-extent start-point end-point)
  21   "Return the x-extent of a string that goes from start-point
  22 to end-point."
  23   (let ((x1 (car start-point))
  24         (x2 (car end-point)))
  25     (if (> x1 x2)
  26         (cons x2 x1)
  27         (cons x1 x2))))
  28
  29 (define (string-y-extent start-point end-point)
  30   "Return the y-extent of a string that goes from start-point
  31 to end-point."
  32   (let ((y1 (cdr start-point))
  33         (y2 (cdr end-point)))
  34     (if (> y1 y2)
  35         (cons y2 y1)
  36         (cons y1 y2))))
  37
  38
  39 (define (cons-fret new-value old-list)
  40   "Put together a fret-list in the format desired by parse-string"
  41   (if (eq? old-list '())
  42       (list new-value)
  43       (cons* new-value old-list)))
  44
  45 (define (get-numeric-from-key keystring)
  46   "Get the numeric value from a key of the form k:val"
  47   (string->number (substring keystring 2 (string-length keystring))))
  48
  49 (define (numerify mylist)
  50   "Convert string values to numeric or character"
  51   (if (null? mylist)
  52       '()
  53       (let ((numeric-value (string->number (car mylist))))
  54         (if numeric-value
  55             (cons* numeric-value (numerify (cdr mylist)))
  56             (cons* (car (string->list (car mylist)))
  57                    (numerify (cdr mylist)))))))
  58
  59 (define (stepmag mag)
  60   "Calculate the font step necessary to get a desired magnification"
  61   (* 6 (/ (log mag) (log 2))))
  62
  63 (define (fret-count fret-range)
  64   "Calculate the fret count for the diagram given the range of frets in the diagram."
  65   (1+ (- (cdr fret-range) (car fret-range))))
  66
  67 (define (dot-has-color dot-settings)
  68   "Return a color-name as symbol, if found in @var{dot-settings} otherwise @code{#f}"
  69   (cond ((null? dot-settings)
  70          #f)
  71         ;; Don't bother the user with quote/unquote.
  72         ;; We use the name-symbol for the color, looking up in 'x11-color-list'
  73         ((member (car dot-settings) (map car x11-color-list))
  74          (car dot-settings))
  75         (else (dot-has-color (cdr dot-settings)))))
  76
  77 (define (dot-is-inverted dot-settings)
  78   "Return @code{'inverted}, if found in @var{dot-settings} otherwise @code{'()}"
  79   (let ((inverted (member 'inverted dot-settings)))
  80     (if inverted
  81         (car inverted)
  82         '())))
  83
  84 (define (dot-is-parenthesized dot-settings)
  85   "Return @code{'parenthesized}, if found in @var{dot-settings} otherwise @code{'()}"
  86   (let ((parenthesized (member 'parenthesized dot-settings)))
  87     (if parenthesized
  88         (car parenthesized)
  89         '())))
  90
  91 ;; If @code{'default-paren-color} is not set, the parenthesis will take their
  92 ;; color from the dot.
  93 ;; Setting @code{'default-paren-color} will result in taking the color from
  94 ;; `what-color', see below.
  95 (define (default-paren-color dot-settings)
  96   "Return @code{'default-paren-color}, if found in @var{dot-settings} otherwise @code{'()}"
  97   (let ((default-color (member 'default-paren-color dot-settings)))
  98     (if default-color
  99         (car default-color)
 100         '())))
 101
 102 (define (subtract-base-fret base-fret dot-list)
 103   "Subtract @var{base-fret} from every fret in @var{dot-list}"
 104   (if (null? dot-list)
 105       '()
 106       (let ((this-list (car dot-list)))
 107         (cons* (list
 108                 ;; string
 109                   (car this-list)
 110                 ;; fret
 111                   (- (second this-list) base-fret)
 112                 ;; finger-number or markup
 113                   (if (and (not (null? (cddr this-list)))
 114                            (or (markup? (caddr this-list))
 115                                (number? (caddr this-list))))
 116                       (third this-list)
 117                       '())
 118                 ;; inverted
 119                   (dot-is-inverted this-list)
 120                 ;; parenthesis
 121                   (dot-is-parenthesized this-list)
 122                 ;; color modifiers
 123                   ;; parenthesis
 124                   (default-paren-color this-list)
 125                   ;; dots
 126                   (let ((colored (dot-has-color this-list)))
 127                     (if colored
 128                         colored
 129                         '())))
 130                (subtract-base-fret base-fret (cdr dot-list))))))
 131
 132 (define (drop-paren item-list)
 133   "Drop a final parentheses from a fret indication list
 134 @code{item-list} resulting from a terse string specification of barre."
 135   (if (> (length item-list) 0)
 136       (let* ((max-index (- (length item-list) 1))
 137              (last-element (car (list-tail item-list max-index))))
 138         (if (or (equal? last-element ")") (equal? last-element "("))
 139             (list-head item-list max-index)
 140             item-list))
 141       item-list))
 142
 143 (define (get-sub-list value master-list)
 144   "Get a sub-list whose cadr is equal to @var{value} from @var{master-list}"
 145   (if (eq? master-list '())
 146       #f
 147       (let ((sublist (car master-list)))
 148         (if (equal? (cadr sublist) value)
 149             sublist
 150             (get-sub-list value (cdr master-list))))))
 151
 152 (define (merge-details key alist-list . default)
 153   "Return @code{alist-list} entries for @code{key}, in one combined alist.
 154 There can be two @code{alist-list} entries for a given key.  The first
 155 comes from the override-markup function, the second comes
 156 from property settings during a regular override.
 157 This is necessary because some details can be set in one
 158 place, while others are set in the other.  Both details
 159 lists must be merged into a single alist.
 160 Return @code{default} (optional, else #f) if not
 161 found."
 162
 163   (define (helper key alist-list default)
 164     (if (null? alist-list)
 165         default
 166         (let* ((entry (assoc-get key (car alist-list))))
 167           (if entry
 168               (append entry (chain-assoc-get key (cdr alist-list) '()))
 169               (helper key (cdr alist-list) default)))))
 170
 171   (helper key alist-list
 172           (if (pair? default) (car default) #f)))
 173
 174 ;;  Conversions between fret/string coordinate system and x-y coordinate
 175 ;;  system.
 176 ;;
 177 ;;  Fret coordinates are measured down the fretboard from the nut,
 178 ;;   starting at 0.
 179 ;;
 180 ;; String coordinates are measured from the lowest string, starting at 0.
 181 ;;
 182 ;; The x-y origin is at the intersection of the nut and the lowest string.
 183 ;;
 184 ;; X coordinates are positive to the right.
 185 ;; Y coordinates are positive up.
 186
 187 (define (negate-extent extent)
 188   "Return the extent in an axis opposite to the axis of @code{extent}."
 189   (cons (- (cdr extent)) (- (car extent))))
 190
 191 (define (stencil-fretboard-extent stencil fretboard-axis orientation)
 192   "Return the extent of @code{stencil} in the @code{fretboard-axis}
 193 direction."
 194   (if (eq? fretboard-axis 'fret)
 195       (cond ((eq? orientation 'landscape)
 196              (ly:stencil-extent stencil X))
 197             ((eq? orientation 'opposing-landscape)
 198              (negate-extent (ly:stencil-extent stencil X)))
 199             (else
 200              (negate-extent (ly:stencil-extent stencil Y))))
 201       ;; else -- eq? fretboard-axis 'string
 202       (cond ((eq? orientation 'landscape)
 203              (ly:stencil-extent stencil Y))
 204             ((eq? orientation 'opposing-landscape)
 205              (negate-extent (ly:stencil-extent stencil Y)))
 206             (else
 207              (ly:stencil-extent stencil Y)))))
 208
 209
 210 (define (stencil-fretboard-offset stencil fretboard-axis orientation)
 211   "Return a the stencil coordinates of the center of @code{stencil}
 212 in the @code{fretboard-axis} direction."
 213   (* 0.5 (interval-length
 214           (stencil-fretboard-extent stencil fretboard-axis orientation))))
 215
 216
 217 (define (string-thickness string thickness-factor)
 218   (expt (1+ thickness-factor) (1- string)))
 219
 220 ;;  Functions that create stencils used in the fret diagram
 221
 222 (define (sans-serif-stencil layout props mag text)
 223   "Create a stencil in sans-serif font based on @var{layout} and @var{props}
 224 with magnification @var{mag} of the string @var{text}."
 225   (let* ((my-props
 226           (prepend-alist-chain
 227            'font-size (stepmag mag)
 228            (prepend-alist-chain 'font-family 'sans props))))
 229     (interpret-markup layout my-props text)))
 230
 231 ;;  markup commands and associated functions
 232
 233 (define (fret-parse-marking-list marking-list my-fret-count)
 234   "Parse a fret-diagram-verbose marking list into component sublists"
 235   (let* ((fret-range (cons 1 my-fret-count))
 236          (capo-fret 0)
 237          (barre-list '())
 238          (dot-list '())
 239          (xo-list '())
 240          (output-alist '()))
 241     (let parse-item ((mylist marking-list))
 242       (if (not (null? mylist))
 243           (let* ((my-item (car mylist)) (my-code (car my-item)))
 244             (cond
 245              ((or (eq? my-code 'open)(eq? my-code 'mute))
 246               (set! xo-list (cons* my-item xo-list)))
 247              ((eq? my-code 'barre)
 248               (set! barre-list (cons* (cdr my-item) barre-list)))
 249              ((eq? my-code 'capo)
 250               (set! capo-fret (cadr my-item)))
 251              ((eq? my-code 'place-fret)
 252               (set! dot-list (cons* (cdr my-item) dot-list))))
 253             (parse-item (cdr mylist)))))
 254     ;; calculate fret-range
 255     (let ((maxfret 0)
 256           (minfret (if (> capo-fret 0) capo-fret 99)))
 257       (let updatemax ((fret-list dot-list))  ;CHANGE THIS TO HELPER FUNCTION?
 258         (if (null? fret-list)
 259             '()
 260             (let ((fretval (second (car fret-list))))
 261               (if (> fretval maxfret) (set! maxfret fretval))
 262               (if (< fretval minfret) (set! minfret fretval))
 263               (updatemax (cdr fret-list)))))
 264       ;; take frets of 'barre-settings into account
 265       (if (not (null? barre-list))
 266           (set! minfret (apply min minfret (map last barre-list))))
 267       (if (or (> maxfret my-fret-count) (> capo-fret 1))
 268           (set! fret-range
 269                 (cons minfret
 270                       (let ((upfret (- (+ minfret my-fret-count) 1)))
 271                         (if (> maxfret upfret) maxfret upfret)))))
 272       (set! capo-fret (1+ (- capo-fret minfret)))
 273       ;; subtract fret from dots
 274       (set! dot-list (subtract-base-fret (- (car fret-range) 1) dot-list)))
 275     (acons 'fret-range fret-range
 276            (acons 'barre-list barre-list
 277                   (acons 'dot-list dot-list
 278                          (acons 'xo-list xo-list
 279                                 (acons 'capo-fret capo-fret '())))))))
 280
 281 (define (make-fret-diagram layout props marking-list)
 282   "Make a fret diagram markup"
 283   (let* (
 284          ;; note: here we get items from props that are needed in this routine,
 285          ;; or that are needed in more than one of the procedures
 286          ;; called from this routine.  If they're only used in one of the
 287          ;; sub-procedure, they're obtained in that procedure
 288          (size (chain-assoc-get 'size props 1.0)) ; needed for everything
 289          ;;TODO -- get string-count directly from length of stringTunings;
 290          ;;         from FretBoard engraver, but not from markup call
 291          (details (merge-details 'fret-diagram-details props '()))
 292          (string-count
 293           (assoc-get 'string-count details 6)) ;; needed for everything
 294          (my-fret-count
 295           (assoc-get 'fret-count details 4)) ;; needed for everything
 296          (orientation
 297           (assoc-get 'orientation details 'normal)) ;; needed for everything
 298          (finger-code
 299           (assoc-get
 300            'finger-code details 'none)) ;; needed for draw-dots and draw-barre
 301          (default-dot-radius
 302            (if (eq? finger-code 'in-dot) 0.425 0.25)) ;; bigger dots if labeled
 303          (default-dot-position
 304            (if (eq? finger-code 'in-dot)
 305                (- 0.95 default-dot-radius)
 306                0.6)) ; move up to make room for bigger dot if labeled
 307          (dot-radius
 308           (assoc-get
 309            'dot-radius details default-dot-radius))
 310          ;; needed for draw-dots and draw-barre
 311          (dot-position
 312           (assoc-get
 313            'dot-position details default-dot-position))
 314          ;; needed for draw-dots and draw-barre
 315          (th
 316           (* (ly:output-def-lookup layout 'line-thickness)
 317              (chain-assoc-get 'thickness props 0.5)))
 318          ;; needed for draw-frets and draw-strings
 319          (sth (* size th))
 320          (thickness-factor (assoc-get 'string-thickness-factor details 0))
 321          (paren-padding (assoc-get 'paren-padding details 0.05))
 322          (alignment
 323           (chain-assoc-get 'align-dir props -0.4)) ;; needed only here
 324          (xo-padding (assoc-get 'xo-padding details 0.2)) ;; needed only here
 325          (parameters (fret-parse-marking-list marking-list my-fret-count))
 326          (capo-fret (assoc-get 'capo-fret parameters 0))
 327          (dot-list (assoc-get 'dot-list parameters))
 328          (xo-list (assoc-get 'xo-list parameters))
 329          (fret-range (assoc-get 'fret-range parameters))
 330          (my-fret-count (fret-count fret-range))
 331          (barre-list (assoc-get 'barre-list parameters))
 332          (barre-type
 333           (assoc-get 'barre-type details 'curved))
 334          (fret-diagram-stencil '()))
 335
 336     ;;  Here are the fret diagram helper functions that depend on the
 337     ;;  fret diagram parameters.  The functions are here because the
 338     ;;  diagram parameters are part of the lexical scope here.
 339
 340     (define (stencil-coordinates fret-coordinate string-coordinate)
 341       "Return a pair @code{(x-coordinate . y-coordinate)}
 342       in stencil coordinate system."
 343       (cond
 344        ((eq? orientation 'landscape)
 345         (cons fret-coordinate
 346               (- string-coordinate (1- string-count))))
 347        ((eq? orientation 'opposing-landscape)
 348         (cons (- fret-coordinate) (- string-coordinate)))
 349        (else
 350         (cons string-coordinate (- fret-coordinate)))))
 351
 352     (define (stencil-coordinate-offset fret-offset string-offset)
 353       "Return a pair @code{(x-offset . y-offset)}
 354       for translation in stencil coordinate system."
 355       (cond
 356        ((eq? orientation 'landscape)
 357         (cons fret-offset (- string-offset)))
 358        ((eq? orientation 'opposing-landscape)
 359         (cons (- fret-offset) string-offset))
 360        (else
 361         (cons string-offset (- fret-offset)))))
 362
 363
 364
 365     (define (make-bezier-sandwich-list start stop base height
 366                                        half-thickness)
 367       "Make the argument list for a bezier sandwich from
 368 string coordinate @var{start} to string-coordinate @var{stop} with a
 369 baseline at fret coordinate @var{base}, a height of
 370 @var{height}, and a half thickness of @var{half-thickness}."
 371       (let* ((width (+ (- stop start) 1))
 372              (cp-left-width (+ (* width half-thickness) start))
 373              (cp-right-width (- stop (* width half-thickness)))
 374              (bottom-control-point-height
 375               (- base (- height half-thickness)))
 376              (top-control-point-height
 377               (- base height))
 378              (left-end-point
 379               (stencil-coordinates base start))
 380              (right-end-point
 381               (stencil-coordinates base stop))
 382              (left-upper-control-point
 383               (stencil-coordinates
 384                top-control-point-height cp-left-width))
 385              (left-lower-control-point
 386               (stencil-coordinates
 387                bottom-control-point-height cp-left-width))
 388              (right-upper-control-point
 389               (stencil-coordinates
 390                top-control-point-height cp-right-width))
 391              (right-lower-control-point
 392               (stencil-coordinates
 393                bottom-control-point-height cp-right-width)))
 394
 395         ;; order of bezier control points is:
 396         ;;    left cp low, right cp low, right end low, left end low
 397         ;;   right cp high, left cp high, left end high, right end high.
 398
 399         (list left-lower-control-point
 400               right-lower-control-point
 401               right-end-point
 402               left-end-point
 403               right-upper-control-point
 404               left-upper-control-point
 405               left-end-point
 406               right-end-point)))
 407
 408     (define (draw-strings)
 409       "Draw the string lines for a fret diagram with
 410 @var{string-count} strings and frets as indicated in @var{fret-range}.
 411 Line thickness is given by @var{th}, fret & string spacing by
 412 @var{size}.  Orientation is determined by @var{orientation}."
 413
 414       (define (helper x)
 415         (if (null? (cdr x))
 416             (string-stencil (car x))
 417             (ly:stencil-add
 418              (string-stencil (car x))
 419              (helper (cdr x)))))
 420
 421       (let* ((string-list (map 1+ (iota string-count))))
 422         (helper string-list)))
 423
 424     (define (string-stencil string)
 425       "Make a stencil for @code{string}, given the fret-diagram
 426       overall parameters."
 427       (let* ((string-coordinate (- string-count string))
 428              (current-string-thickness
 429               (* th size (string-thickness string thickness-factor)))
 430              (fret-half-thickness (* size th 0.5))
 431              (half-string (* current-string-thickness 0.5))
 432              (start-coordinates
 433               (stencil-coordinates
 434                (- fret-half-thickness)
 435                (- (* size string-coordinate) half-string)))
 436              (end-coordinates
 437               (stencil-coordinates
 438                (+ fret-half-thickness (* size (1+ (fret-count fret-range))))
 439                (+ half-string (* size string-coordinate)))))
 440         (ly:round-filled-box
 441          (string-x-extent start-coordinates end-coordinates)
 442          (string-y-extent start-coordinates end-coordinates)
 443          (* th size))))
 444
 445     (define (draw-frets)
 446       "Draw the fret lines for a fret diagram with
 447 @var{string-count} strings and frets as indicated in @var{fret-range}.
 448 Line thickness is given by @var{th}, fret & string spacing by
 449 @var{size}.  Orientation is given by @var{orientation}."
 450       (define (helper x)
 451         (if (null? (cdr x))
 452             (fret-stencil (car x))
 453             (ly:stencil-add
 454              (fret-stencil (car x))
 455              (helper (cdr x)))))
 456
 457       (let ((fret-list (iota (1+ my-fret-count))))
 458         (helper fret-list)))
 459
 460     (define (fret-stencil fret)
 461       "Make a stencil for @code{fret}, given the
 462 fret-diagram overall parameters."
 463       (let* ((low-string-half-thickness
 464               (* 0.5
 465                  size
 466                  th
 467                  (string-thickness string-count thickness-factor)))
 468              (fret-half-thickness (* 0.5 size th))
 469              (start-coordinates
 470               (stencil-coordinates
 471                (* size fret)
 472                (- fret-half-thickness low-string-half-thickness)))
 473              (end-coordinates
 474               (stencil-coordinates
 475                (* size fret)
 476                (* size (1- string-count)))))
 477         (make-line-stencil
 478          (* size th)
 479          (car start-coordinates) (cdr start-coordinates)
 480          (car end-coordinates) (cdr end-coordinates))))
 481
 482     (define (draw-barre barre-list)
 483       "Create barre indications for a fret diagram"
 484       (if (not (null? barre-list))
 485           (let* ((string1 (caar barre-list))
 486                  (string2 (cadar barre-list))
 487                  (barre-fret (caddar barre-list))
 488                  (top-fret (cdr fret-range))
 489                  (low-fret (car fret-range))
 490                  (fret (1+ (- barre-fret low-fret)))
 491                  (barre-vertical-offset 0.5)
 492                  (dot-center-fret-coordinate (+ (1- fret) dot-position))
 493                  (barre-fret-coordinate
 494                   (+ dot-center-fret-coordinate
 495                      (* (- barre-vertical-offset 0.5) dot-radius)))
 496                  (barre-start-string-coordinate (- string-count string1))
 497                  (barre-end-string-coordinate (- string-count string2))
 498                  (scale-dot-radius (* size dot-radius))
 499                  (barre-type (assoc-get 'barre-type details 'curved))
 500                  (barre-stencil
 501                   (cond
 502                    ((eq? barre-type 'straight)
 503                     (make-straight-barre-stencil
 504                      barre-fret-coordinate
 505                      barre-start-string-coordinate
 506                      barre-end-string-coordinate
 507                      scale-dot-radius))
 508                    ((eq? barre-type 'curved)
 509                     (make-curved-barre-stencil
 510                      barre-fret-coordinate
 511                      barre-start-string-coordinate
 512                      barre-end-string-coordinate
 513                      scale-dot-radius)))))
 514             (if (not (null? (cdr barre-list)))
 515                 (ly:stencil-add
 516                  barre-stencil
 517                  (draw-barre (cdr barre-list)))
 518                 barre-stencil ))))
 519
 520     (define (make-straight-barre-stencil
 521              fret-coordinate
 522              start-string-coordinate
 523              end-string-coordinate
 524              half-thickness)
 525       "Create a straight barre stencil."
 526       (let ((start-point
 527              (stencil-coordinates
 528               (* size fret-coordinate)
 529               (* size start-string-coordinate)))
 530             (end-point
 531              (stencil-coordinates
 532               (* size fret-coordinate)
 533               (* size end-string-coordinate))))
 534         (make-line-stencil
 535          half-thickness
 536          (car start-point)
 537          (cdr start-point)
 538          (car end-point)
 539          (cdr end-point))))
 540
 541     (define (make-curved-barre-stencil
 542              fret-coordinate
 543              start-string-coordinate
 544              end-string-coordinate
 545              half-thickness)
 546       "Create a curved barre stencil."
 547       (let* ((bezier-thick 0.1)
 548              (bezier-height 0.5)
 549              (bezier-list
 550               (make-bezier-sandwich-list
 551                (* size start-string-coordinate)
 552                (* size end-string-coordinate)
 553                (* size fret-coordinate)
 554                (* size bezier-height)
 555                (* size bezier-thick)))
 556              (box-lower-left
 557               (stencil-coordinates
 558                (+ (* size fret-coordinate) half-thickness)
 559                (- (* size start-string-coordinate) half-thickness)))
 560              (box-upper-right
 561               (stencil-coordinates
 562                (- (* size fret-coordinate)
 563                   (* size bezier-height)
 564                   half-thickness)
 565                (+ (* size end-string-coordinate) half-thickness)))
 566              (x-extent (cons (car box-lower-left) (car box-upper-right)))
 567              (y-extent (cons (cdr box-lower-left) (cdr box-upper-right))))
 568         (make-bezier-sandwich-stencil
 569          bezier-list
 570          (* size bezier-thick)
 571          x-extent
 572          y-extent)))
 573
 574     (define (draw-dots dot-list)
 575       "Make dots for fret diagram."
 576
 577       (let* ( (scale-dot-radius (* size dot-radius))
 578               (scale-dot-thick (* size th))
 579               (default-dot-color (assoc-get 'dot-color details))
 580               (finger-label-padding 0.3)
 581               (dot-label-font-mag
 582                (* scale-dot-radius
 583                   (assoc-get 'dot-label-font-mag details 1.0)))
 584               (string-label-font-mag
 585                (* size
 586                   (assoc-get
 587                    'string-label-font-mag details
 588                    (cond ((or (eq? orientation 'landscape)
 589                               (eq? orientation 'opposing-landscape))
 590                           0.5)
 591                          (else  0.6)))))
 592               (mypair (car dot-list))
 593               (restlist (cdr dot-list))
 594               (string (car mypair))
 595               (fret (cadr mypair))
 596               (fret-coordinate (* size (+ (1- fret) dot-position)))
 597               (string-coordinate (* size (- string-count string)))
 598               (dot-coordinates
 599                (stencil-coordinates fret-coordinate string-coordinate))
 600               (extent (cons (- scale-dot-radius) scale-dot-radius))
 601               (finger (caddr mypair))
 602               (finger (if (number? finger) (number->string finger) finger))
 603               (parenthesized
 604                 (if (not (null? (dot-is-parenthesized mypair)))
 605                     (dot-is-parenthesized mypair)
 606                     #f))
 607               (parenthesis-color
 608                 (if (not (null? (default-paren-color mypair)))
 609                     (default-paren-color mypair)
 610                     #f))
 611               (inverted
 612                 (if (not (null? (dot-is-inverted mypair)))
 613                     (dot-is-inverted mypair)
 614                     #f))
 615               (dot-color-is-white?
 616                 (or inverted
 617                     (and (eq? default-dot-color 'white) (not inverted))))
 618               (what-color
 619                 (x11-color
 620                   (cond ((and inverted
 621                               (not (dot-has-color mypair))
 622                               (not (eq? default-dot-color 'white)))
 623                           (or default-dot-color 'black))
 624                         (dot-color-is-white?
 625                           (or (dot-has-color mypair) 'black))
 626                         (else
 627                           (or (dot-has-color mypair)
 628                               default-dot-color
 629                               'black)))))
 630               (inverted-stil
 631                 (lambda (color)
 632                   (ly:stencil-add
 633                     (stencil-with-color
 634                       (make-circle-stencil
 635                         scale-dot-radius scale-dot-thick #t)
 636                       color)
 637                     (stencil-with-color
 638                       (make-circle-stencil
 639                         (- scale-dot-radius (* 0.5 scale-dot-thick))
 640                         0  #t)
 641                       (x11-color 'white)))))
 642               (dot-stencil
 643                 (if dot-color-is-white?
 644                     (inverted-stil what-color)
 645                     (stencil-with-color
 646                       (make-circle-stencil
 647                          scale-dot-radius scale-dot-thick #t)
 648                       what-color)))
 649               (par-dot-stencil
 650                 (let ((paren-color
 651                         (if (and parenthesis-color
 652                                  (not (eq? default-dot-color 'white)))
 653                             (x11-color (or default-dot-color 'black))
 654                             what-color)))
 655                  (stencil-with-color
 656                    (parenthesize-stencil
 657                      dot-stencil      ;; stencil
 658                      (* size th 0.75) ;; half-thickness
 659                      (* 0.15 size)    ;;width
 660                      0                ;; angularity
 661                      paren-padding    ;; padding
 662                      )
 663                    paren-color)))
 664               (final-dot-stencil
 665                   (if parenthesized
 666                       par-dot-stencil
 667                       dot-stencil))
 668               (positioned-dot
 669                (ly:stencil-translate final-dot-stencil dot-coordinates))
 670               (labeled-dot-stencil
 671                (cond
 672                 ((or (eq? finger '())(eq? finger-code 'none))
 673                  positioned-dot)
 674                 ((eq? finger-code 'in-dot)
 675                  (let* ((finger-stil
 676                           (if (not (null? finger))
 677                               (sans-serif-stencil
 678                                  layout props dot-label-font-mag finger)
 679                               empty-stencil))
 680                         (finger-stil-length
 681                           (interval-length (ly:stencil-extent finger-stil X)))
 682                         (finger-stil-height
 683                           (interval-length (ly:stencil-extent finger-stil Y)))
 684                         (dot-stencil-radius
 685                           (/ (interval-length (ly:stencil-extent dot-stencil Y))
 686                              2))
 687                         (scale-factor
 688                           (/ dot-stencil-radius
 689                              ;; Calculate the radius of the circle through the
 690                              ;; corners of the box containing the finger-stil.
 691                              ;; Give it a little padding. The value, (* 2 th),
 692                              ;; is my choice
 693                              (+
 694                                (sqrt
 695                                   (+ (expt (/ finger-stil-length 2) 2)
 696                                      (expt (/ finger-stil-height 2) 2)))
 697                                 (* 2 th))))
 698                         (finger-label
 699                          (centered-stencil
 700                           (ly:stencil-scale
 701                            (sans-serif-stencil
 702                             layout props
 703                             dot-label-font-mag
 704                             finger)
 705                            scale-factor scale-factor))))
 706                    (ly:stencil-translate
 707                     (ly:stencil-add
 708                      final-dot-stencil
 709                      (if dot-color-is-white?
 710                          (stencil-with-color
 711                             finger-label
 712                             what-color)
 713                          (stencil-with-color finger-label white)))
 714                     dot-coordinates)))
 715                 ((eq? finger-code 'below-string)
 716                  (let* ((label-stencil
 717                          (centered-stencil
 718                           (sans-serif-stencil
 719                            layout props string-label-font-mag
 720                            finger)))
 721                         (label-fret-offset
 722                          (stencil-fretboard-offset
 723                           label-stencil 'fret orientation))
 724                         (label-fret-coordinate
 725                          (+ (* size
 726                                (+ 1 my-fret-count finger-label-padding))
 727                             label-fret-offset))
 728                         (label-string-coordinate string-coordinate)
 729                         (label-translation
 730                          (stencil-coordinates
 731                           label-fret-coordinate
 732                           label-string-coordinate)))
 733                    (ly:stencil-add
 734                     positioned-dot
 735                     (ly:stencil-translate
 736                      label-stencil
 737                      label-translation))))
 738                 (else ;unknown finger-code
 739                  positioned-dot))))
 740         (if (null? restlist)
 741             labeled-dot-stencil
 742             (ly:stencil-add
 743              (draw-dots restlist)
 744              labeled-dot-stencil))))
 745
 746     (define (draw-thick-zero-fret)
 747       "Draw a thick zeroth fret for a fret diagram whose base fret is 1."
 748       (let* ((half-lowest-string-thickness
 749               (* 0.5 th (string-thickness string-count thickness-factor)))
 750              (half-thick (* 0.5 sth))
 751              (top-fret-thick
 752               (* sth (assoc-get 'top-fret-thickness details 3.0)))
 753              (start-string-coordinate (- half-lowest-string-thickness))
 754              (end-string-coordinate (+ (* size (1- string-count)) half-thick))
 755              (start-fret-coordinate half-thick)
 756              (end-fret-coordinate (- half-thick top-fret-thick))
 757              (lower-left
 758               (stencil-coordinates
 759                start-fret-coordinate start-string-coordinate))
 760              (upper-right
 761               (stencil-coordinates
 762                end-fret-coordinate end-string-coordinate)))
 763         (ly:round-filled-box
 764          ;; Put limits in order, or else the intervals are considered empty
 765          (ordered-cons (car lower-left) (car upper-right))
 766          (ordered-cons (cdr lower-left) (cdr upper-right))
 767          sth)))
 768
 769     (define (draw-xo xo-list)
 770       "Put open and mute string indications on diagram, as contained in
 771 @var{xo-list}."
 772       (let* ((xo-font-mag
 773               (assoc-get 'xo-font-magnification details
 774                          (cond ((or (eq? orientation 'landscape)
 775                                     (eq? orientation 'opposing-landscape))
 776                                 0.4)
 777                                (else 0.4))))
 778              (mypair (car xo-list))
 779              (restlist (cdr xo-list))
 780              (glyph-string (if (eq? (car mypair) 'mute)
 781                                (assoc-get 'mute-string details "X")
 782                                (assoc-get 'open-string details "O")))
 783              (glyph-string-coordinate (* (- string-count (cadr mypair)) size))
 784              (glyph-stencil
 785               (centered-stencil
 786                (sans-serif-stencil
 787                 layout props (* size xo-font-mag) glyph-string)))
 788              (glyph-stencil-coordinates
 789               (stencil-coordinates 0 glyph-string-coordinate))
 790              (positioned-glyph
 791               (ly:stencil-translate
 792                glyph-stencil
 793                glyph-stencil-coordinates)))
 794         (if (null? restlist)
 795             positioned-glyph
 796             (ly:stencil-add
 797              positioned-glyph
 798              (draw-xo restlist)))))
 799
 800     (define (draw-capo fret)
 801       "Draw a capo indicator across the full width of the fret-board
 802 at @var{fret}."
 803       (let* ((capo-thick
 804               (* size (assoc-get 'capo-thickness details 0.5)))
 805              (half-thick (* capo-thick 0.5))
 806              (last-string-position 0)
 807              (first-string-position (* size (- string-count 1)))
 808              (fret-position ( * size (1- (+ dot-position fret))))
 809              (start-point
 810               (stencil-coordinates
 811                fret-position
 812                first-string-position))
 813              (end-point
 814               (stencil-coordinates
 815                fret-position
 816                last-string-position)))
 817         (make-line-stencil
 818          capo-thick
 819          (car start-point) (cdr start-point)
 820          (car end-point) (cdr end-point))))
 821
 822     (define (label-fret fret-range)
 823       "Label the base fret on a fret diagram"
 824       (let* ((base-fret (car fret-range))
 825              (label-font-mag (assoc-get 'fret-label-font-mag details 0.5))
 826              (label-space (* 0.5 size))
 827              (label-dir (assoc-get 'label-dir details RIGHT))
 828              (label-vertical-offset
 829               (assoc-get 'fret-label-vertical-offset details 0))
 830              (label-horizontal-offset
 831               (assoc-get 'fret-label-horizontal-offset details 0))
 832              (number-type
 833               (assoc-get 'number-type details 'roman-lower))
 834              (label-text
 835               (number-format number-type base-fret
 836                              (assoc-get 'fret-label-custom-format
 837                                          details "~a")))
 838              (label-stencil
 839               (centered-stencil
 840                (sans-serif-stencil
 841                 layout props (* size label-font-mag) label-text)))
 842              (label-half-width
 843               (stencil-fretboard-offset
 844                label-stencil
 845                'string
 846                orientation))
 847              (label-outside-diagram
 848                (+ label-space
 849                   (* size label-horizontal-offset)
 850                   label-half-width)))
 851         (ly:stencil-translate
 852          label-stencil
 853          (stencil-coordinates
 854           (* size (+ 1.0 label-vertical-offset))
 855           (if (eq? label-dir LEFT)
 856               (- label-outside-diagram)
 857               (+ (* size (1- string-count)) label-outside-diagram))))))
 858
 859     ;; Here is the body of make-fret-diagram
 860
 861     (set! fret-diagram-stencil
 862           (ly:stencil-add (draw-strings) (draw-frets)))
 863     (if (and (not (null? barre-list))
 864              (not (eq? 'none barre-type)))
 865         (set! fret-diagram-stencil
 866               (ly:stencil-add
 867                (draw-barre barre-list)
 868                fret-diagram-stencil)))
 869     (if (not (null? dot-list))
 870         (set! fret-diagram-stencil
 871               (ly:stencil-add
 872                fret-diagram-stencil
 873                (draw-dots dot-list))))
 874     (if (= (car fret-range) 1)
 875         (set! fret-diagram-stencil
 876               (ly:stencil-add
 877                fret-diagram-stencil
 878                (draw-thick-zero-fret))))
 879     (if (not (null? xo-list))
 880         (let* ((diagram-fret-top
 881                 (car (stencil-fretboard-extent
 882                       fret-diagram-stencil
 883                       'fret
 884                       orientation)))
 885                (xo-stencil (draw-xo xo-list))
 886                (xo-fret-offset
 887                 (stencil-fretboard-offset
 888                  xo-stencil 'fret orientation))
 889                (xo-stencil-offset
 890                 (stencil-coordinate-offset
 891                  (- diagram-fret-top
 892                     xo-fret-offset
 893                     (* size xo-padding))
 894                  0)))
 895           (set! fret-diagram-stencil
 896                 (ly:stencil-add
 897                  fret-diagram-stencil
 898                  (ly:stencil-translate
 899                   xo-stencil
 900                   xo-stencil-offset)))))
 901     (if (> capo-fret 0)
 902         (set! fret-diagram-stencil
 903               (ly:stencil-add
 904                fret-diagram-stencil
 905                (draw-capo capo-fret))))
 906     (if (> (car fret-range) 1)
 907         (set! fret-diagram-stencil
 908               (ly:stencil-add
 909                fret-diagram-stencil
 910                (label-fret fret-range))))
 911     (ly:stencil-aligned-to fret-diagram-stencil X alignment)))
 912
 913 (define (fret-parse-definition-string props definition-string)
 914   "Parse a fret diagram string and return a pair containing:
 915 @var{props}, modified as necessary by the definition-string
 916 a fret-indication list with the appropriate values"
 917   (let* ((fret-count 4)
 918          (string-count 6)
 919          (fret-range (cons 1 fret-count))
 920          (barre-list '())
 921          (dot-list '())
 922          (xo-list '())
 923          (output-list '())
 924          (new-props '())
 925          (details (merge-details 'fret-diagram-details props '()))
 926          (items (string-split definition-string #\;)))
 927     (let parse-item ((myitems items))
 928       (if (not (null? (cdr myitems)))
 929           (let ((test-string (car myitems)))
 930             (case (car (string->list (substring test-string 0 1)))
 931               ((#\s) (let ((size (get-numeric-from-key test-string)))
 932                        (set! props (prepend-alist-chain 'size size props))))
 933               ((#\t) (let ((th (get-numeric-from-key test-string)))
 934                        (set! props (prepend-alist-chain 'thickness th props))))
 935               ((#\f) (let* ((finger-code (get-numeric-from-key test-string))
 936                             (finger-id (case finger-code
 937                                          ((0) 'none)
 938                                          ((1) 'in-dot)
 939                                          ((2) 'below-string))))
 940                        (set! details
 941                              (acons 'finger-code finger-id details))))
 942               ((#\c) (set! output-list
 943                            (cons-fret
 944                             (cons
 945                              'barre
 946                              (numerify
 947                               (string-split (substring test-string 2) #\-)))
 948                             output-list)))
 949               ((#\h) (let ((fret-count (get-numeric-from-key test-string)))
 950                        (set! details
 951                              (acons 'fret-count fret-count details))))
 952               ((#\w) (let ((string-count (get-numeric-from-key test-string)))
 953                        (set! details
 954                              (acons 'string-count string-count details))))
 955               ((#\d) (let ((dot-size (get-numeric-from-key test-string)))
 956                        (set! details
 957                              (acons 'dot-radius dot-size details))))
 958               ((#\p) (let ((dot-position (get-numeric-from-key test-string)))
 959                        (set! details
 960                              (acons 'dot-position dot-position details))))
 961               (else
 962                (let ((this-list (string-split test-string #\-)))
 963                  (if (string->number (cadr this-list))
 964                      (set! output-list
 965                            (cons-fret
 966                             (cons 'place-fret (numerify this-list))
 967                             output-list))
 968                      (if (equal? (cadr this-list) "x" )
 969                          (set! output-list
 970                                (cons-fret
 971                                 (list 'mute (string->number (car this-list)))
 972                                 output-list))
 973                          (set! output-list
 974                                (cons-fret
 975                                 (list 'open (string->number (car this-list)))
 976                                 output-list)))))))
 977             (parse-item (cdr myitems)))))
 978     ;; add the modified details
 979     (set! props
 980           (prepend-alist-chain 'fret-diagram-details details props))
 981     `(,props . ,output-list))) ;ugh -- hard-coded spell -- procedure better
 982
 983 (define-public
 984   (fret-parse-terse-definition-string props definition-string)
 985   "Parse a fret diagram string that uses terse syntax;
 986 return a pair containing:
 987 @var{props}, modified to include the string-count determined by the
 988 definition-string, and
 989 a fret-indication list with the appropriate values"
 990   ;; TODO -- change syntax to fret\string-finger
 991
 992   (let* ((details (merge-details 'fret-diagram-details props '()))
 993          (barre-start-list '())
 994          (output-list '())
 995          (new-props '())
 996          (items (string-split definition-string #\;))
 997          (string-count (- (length items) 1)))
 998     (let parse-item ((myitems items))
 999       (if (not (null? (cdr myitems)))
1000           (let* ((test-string (car myitems))
1001                  (current-string (- (length myitems) 1))
1002                  (indicators (string-split test-string #\ )))
1003             (let parse-indicators ((myindicators indicators))
1004               (if (not (eq? '() myindicators))
1005                   (let* ((this-list (string-split (car myindicators) #\-))
1006                          (max-element-index (- (length this-list) 1))
1007                          (last-element
1008                           (car (list-tail this-list max-element-index)))
1009                          (fret
1010                           (if (string->number (car this-list))
1011                               (string->number (car this-list))
1012                               (car this-list))))
1013                     (if (equal? last-element "(")
1014                         (begin
1015                           (set! barre-start-list
1016                                 (cons-fret (list current-string fret)
1017                                            barre-start-list))
1018                           (set! this-list
1019                                 (list-head this-list max-element-index))))
1020                     (if (equal? last-element ")")
1021                         (let* ((this-barre
1022                                 (get-sub-list fret barre-start-list))
1023                                (insert-index (- (length this-barre) 1)))
1024                           (set! output-list
1025                                 (cons-fret (cons* 'barre
1026                                                   (car this-barre)
1027                                                   current-string
1028                                                   (cdr this-barre))
1029                                            output-list))
1030                           (set! this-list
1031                                 (list-head this-list max-element-index))))
1032                     (if (number? fret)
1033                         (set!
1034                          output-list
1035                          (cons-fret (cons*
1036                                      'place-fret
1037                                      current-string
1038                                      (drop-paren (numerify this-list)))
1039                                     output-list))
1040                         (if (equal? (car this-list) "x" )
1041                             (set!
1042                              output-list
1043                              (cons-fret
1044                               (list 'mute current-string)
1045                               output-list))
1046                             (set!
1047                              output-list
1048                              (cons-fret
1049                               (list 'open current-string)
1050                               output-list))))
1051                     (parse-indicators (cdr myindicators)))))
1052             (parse-item (cdr myitems)))))
1053     (set! details (acons 'string-count string-count details))
1054     (set! props (prepend-alist-chain 'fret-diagram-details details props))
1055     `(,props . ,output-list))) ; ugh -- hard coded; proc is better
1056
1057
1058 (define-markup-command
1059   (fret-diagram-verbose layout props marking-list)
1060   (pair?) ; argument type (list, but use pair? for speed)
1061   #:category instrument-specific-markup ; markup type
1062   #:properties ((align-dir -0.4) ; properties and defaults
1063                 (size 1.0)
1064                 (fret-diagram-details)
1065                 (thickness 0.5))
1066   "Make a fret diagram containing the symbols indicated in @var{marking-list}.
1067
1068   For example,
1069
1070 @example
1071 \\markup \\fret-diagram-verbose
1072   #'((mute 6) (mute 5) (open 4)
1073      (place-fret 3 2) (place-fret 2 3) (place-fret 1 2))
1074 @end example
1075
1076 @noindent
1077 produces a standard D@tie{}chord diagram without fingering indications.
1078
1079 Possible elements in @var{marking-list}:
1080
1081 @table @code
1082 @item (mute @var{string-number})
1083 Place a small @q{x} at the top of string @var{string-number}.
1084
1085 @item (open @var{string-number})
1086 Place a small @q{o} at the top of string @var{string-number}.
1087
1088 @item (barre @var{start-string} @var{end-string} @var{fret-number})
1089 Place a barre indicator (much like a tie) from string @var{start-string}
1090 to string @var{end-string} at fret @var{fret-number}.
1091
1092 @item (capo @var{fret-number})
1093 Place a capo indicator (a large solid bar) across the entire fretboard
1094 at fret location @var{fret-number}.  Also, set fret @var{fret-number}
1095 to be the lowest fret on the fret diagram.
1096 @item
1097 (place-fret @var{string-number}
1098             @var{fret-number}
1099             [@var{finger-value}]
1100             [@var{color-modifier}]
1101             [@var{color}]
1102             [@code{'parenthesized} [@code{'default-paren-color}]])
1103 Place a fret playing indication on string @var{string-number} at fret
1104 @var{fret-number} with an optional fingering label @var{finger-value},
1105 an optional color modifier @var{color-modifier}, an optional color
1106 @var{color}, an optional parenthesis @code{'parenthesized} and an
1107 optional paranthesis color @code{'default-paren-color}.
1108 By default, the fret playing indicator is a solid dot.  This can be
1109 globally changed by setting the value of the variable @var{dot-color}
1110 or for a single dot by setting the value of @var{color}.  The dot can
1111 be parenthesized by adding @code{'parenthesized}.  By default the
1112 color for the parenthesis is taken from the dot.  Adding
1113 @code{'default-paren-color} will take the parenthesis-color from the
1114 global @var{dot-color}, as a fall-back black will be used.
1115 Setting @var{color-modifier} to @code{inverted} inverts the dot color
1116 for a specific fingering.
1117 The values for @var{string-number}, @var{fret-number}, and the optional
1118 @var{finger} should be entered first in that order.
1119 The order of the other optional arguments does not matter.
1120 If the @var{finger} part of the @code{place-fret} element is present,
1121 @var{finger-value} will be displayed according to the setting of the
1122 variable @var{finger-code}.  There is no limit to the number of fret
1123 indications per string.
1124 @end table"
1125
1126   (make-fret-diagram layout props marking-list))
1127
1128
1129 (define-markup-command (fret-diagram layout props definition-string)
1130   (string?) ; argument type
1131   #:category instrument-specific-markup ; markup category
1132   #:properties (fret-diagram-verbose-markup) ; properties and defaults
1133   "Make a (guitar) fret diagram.  For example, say
1134
1135 @example
1136 \\markup \\fret-diagram #\"s:0.75;6-x;5-x;4-o;3-2;2-3;1-2;\"
1137 @end example
1138
1139 @noindent
1140 for fret spacing 3/4 of staff space, D chord diagram
1141
1142 Syntax rules for @var{definition-string}:
1143 @itemize @minus
1144
1145 @item
1146 Diagram items are separated by semicolons.
1147
1148 @item
1149 Possible items:
1150
1151 @itemize @bullet
1152 @item
1153 @code{s:}@var{number} -- Set the fret spacing of the diagram (in staff
1154 spaces).
1155 Default:@tie{}1.
1156
1157 @item
1158 @code{t:}@var{number} -- Set the line thickness (relative to normal
1159 line thickness).
1160 Default:@tie{}0.5.
1161
1162 @item
1163 @code{h:}@var{number} -- Set the height of the diagram in frets.
1164 Default:@tie{}4.
1165
1166 @item
1167 @code{w:}@var{number} -- Set the width of the diagram in strings.
1168 Default:@tie{}6.
1169
1170 @item
1171 @code{f:}@var{number} -- Set fingering label type
1172  (0@tie{}= none, 1@tie{}= in circle on string, 2@tie{}= below string).
1173 Default:@tie{}0.
1174
1175 @item
1176 @code{d:}@var{number} -- Set radius of dot, in terms of fret spacing.
1177 Default:@tie{}0.25.
1178
1179 @item
1180 @code{p:}@var{number} -- Set the position of the dot in the fret space.
1181 0.5 is centered; 1@tie{}is on lower fret bar, 0@tie{}is on upper fret bar.
1182 Default:@tie{}0.6.
1183
1184 @item
1185 @code{c:}@var{string1}@code{-}@var{string2}@code{-}@var{fret} -- Include a
1186 barre mark from @var{string1} to @var{string2} on @var{fret}.
1187
1188 @item
1189 @var{string}@code{-}@var{fret} -- Place a dot on @var{string} at @var{fret}.
1190 If @var{fret} is @samp{o}, @var{string} is identified as open.
1191 If @var{fret} is @samp{x}, @var{string} is identified as muted.
1192
1193 @item
1194 @var{string}@code{-}@var{fret}@code{-}@var{fingering} -- Place a dot on
1195 @var{string} at @var{fret}, and label with @var{fingering} as defined
1196 by the @code{f:} code.
1197 @end itemize
1198
1199 @item
1200 Note: There is no limit to the number of fret indications per string.
1201 @end itemize"
1202   (let ((definition-list
1203           (fret-parse-definition-string props definition-string)))
1204     (fret-diagram-verbose-markup
1205      layout (car definition-list) (cdr definition-list))))
1206
1207 (define-markup-command
1208   (fret-diagram-terse layout props definition-string)
1209   (string?) ; argument type
1210   #:category instrument-specific-markup ; markup category
1211   #:properties (fret-diagram-verbose-markup) ; properties
1212   "Make a fret diagram markup using terse string-based syntax.
1213
1214 Here is an example
1215
1216 @example
1217 \\markup \\fret-diagram-terse #\"x;x;o;2;3;2;\"
1218 @end example
1219
1220 @noindent
1221 for a D@tie{}chord diagram.
1222
1223 Syntax rules for @var{definition-string}:
1224
1225 @itemize @bullet
1226
1227 @item
1228 Strings are terminated by semicolons; the number of semicolons
1229 is the number of strings in the diagram.
1230
1231 @item
1232 Mute strings are indicated by @samp{x}.
1233
1234 @item
1235 Open strings are indicated by @samp{o}.
1236
1237 @item
1238 A number indicates a fret indication at that fret.
1239
1240 @item
1241 If there are multiple fret indicators desired on a string, they
1242 should be separated by spaces.
1243
1244 @item
1245 Fingerings are given by following the fret number with a @w{@code{-},}
1246 followed by the finger indicator, e.g. @samp{3-2} for playing the third
1247 fret with the second finger.
1248
1249 @item
1250 Where a barre indicator is desired, follow the fret (or fingering) symbol
1251 with @w{@code{-(}} to start a barre and @w{@code{-)}} to end the barre.
1252
1253 @end itemize"
1254   ;; TODO -- change syntax to fret\string-finger
1255   (let ((definition-list
1256           (fret-parse-terse-definition-string props definition-string)))
1257     (fret-diagram-verbose-markup layout
1258                                  (car definition-list)
1259                                  (cdr definition-list))))