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