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       (if (not (zero? (apply min capo-fret (map cadr dot-list))))
 285           (set! capo-fret (1+ (- capo-fret minfret))))
 286       ;; subtract fret from dots
 287       (set! dot-list (subtract-base-fret (- (car fret-range) 1) dot-list)))
 288     (acons 'fret-range fret-range
 289            (acons 'barre-list barre-list
 290                   (acons 'dot-list dot-list
 291                          (acons 'xo-list xo-list
 292                                 (acons 'capo-fret capo-fret '())))))))
 293
 294 (define (make-fret-diagram layout props marking-list)
 295   "Make a fret diagram markup"
 296   (let* (
 297          ;; note: here we get items from props that are needed in this routine,
 298          ;; or that are needed in more than one of the procedures
 299          ;; called from this routine.  If they're only used in one of the
 300          ;; sub-procedure, they're obtained in that procedure
 301          (size (chain-assoc-get 'size props 1.0)) ; needed for everything
 302          ;;TODO -- get string-count directly from length of stringTunings;
 303          ;;         from FretBoard engraver, but not from markup call
 304          (details (merge-details 'fret-diagram-details props '()))
 305          (string-count
 306           (assoc-get 'string-count details 6)) ;; needed for everything
 307          (my-fret-count
 308           (assoc-get 'fret-count details 4)) ;; needed for everything
 309          (orientation
 310           (assoc-get 'orientation details 'normal)) ;; needed for everything
 311          (finger-code
 312           (assoc-get
 313            'finger-code details 'none)) ;; needed for draw-dots and draw-barre
 314          (default-dot-radius
 315            (if (eq? finger-code 'in-dot) 0.425 0.25)) ;; bigger dots if labeled
 316          (default-dot-position
 317            (if (eq? finger-code 'in-dot)
 318                (- 0.95 default-dot-radius)
 319                0.6)) ; move up to make room for bigger dot if labeled
 320          (dot-radius
 321           (assoc-get
 322            'dot-radius details default-dot-radius))
 323          ;; needed for draw-dots and draw-barre
 324          (dot-position
 325           (assoc-get
 326            'dot-position details default-dot-position))
 327          ;; needed for draw-dots and draw-barre
 328          (th
 329           (* (ly:output-def-lookup layout 'line-thickness)
 330              (chain-assoc-get 'thickness props 0.5)))
 331          ;; needed for draw-frets and draw-strings
 332          (sth (* size th))
 333          (thickness-factor (assoc-get 'string-thickness-factor details 0))
 334          (paren-padding (assoc-get 'paren-padding details 0.05))
 335          (alignment
 336           (chain-assoc-get 'align-dir props -0.4)) ;; needed only here
 337          (xo-padding (assoc-get 'xo-padding details 0.2)) ;; needed only here
 338          (parameters (fret-parse-marking-list marking-list my-fret-count))
 339          (capo-fret (assoc-get 'capo-fret parameters 0))
 340          (dot-list (assoc-get 'dot-list parameters))
 341          (xo-list (assoc-get 'xo-list parameters))
 342          (fret-range (assoc-get 'fret-range parameters))
 343          (my-fret-count (fret-count fret-range))
 344          (barre-list (assoc-get 'barre-list parameters))
 345          (barre-type
 346           (assoc-get 'barre-type details 'curved))
 347          (fret-diagram-stencil '()))
 348
 349     ;;  Here are the fret diagram helper functions that depend on the
 350     ;;  fret diagram parameters.  The functions are here because the
 351     ;;  diagram parameters are part of the lexical scope here.
 352
 353     (define (stencil-coordinates fret-coordinate string-coordinate)
 354       "Return a pair @code{(x-coordinate . y-coordinate)}
 355       in stencil coordinate system."
 356       (cond
 357        ((eq? orientation 'landscape)
 358         (cons fret-coordinate
 359               (- string-coordinate (1- string-count))))
 360        ((eq? orientation 'opposing-landscape)
 361         (cons (- fret-coordinate) (- string-coordinate)))
 362        (else
 363         (cons string-coordinate (- fret-coordinate)))))
 364
 365     (define (stencil-coordinate-offset fret-offset string-offset)
 366       "Return a pair @code{(x-offset . y-offset)}
 367       for translation in stencil coordinate system."
 368       (cond
 369        ((eq? orientation 'landscape)
 370         (cons fret-offset (- string-offset)))
 371        ((eq? orientation 'opposing-landscape)
 372         (cons (- fret-offset) string-offset))
 373        (else
 374         (cons string-offset (- fret-offset)))))
 375
 376
 377
 378     (define (make-bezier-sandwich-list start stop base height
 379                                        half-thickness)
 380       "Make the argument list for a bezier sandwich from
 381 string coordinate @var{start} to string-coordinate @var{stop} with a
 382 baseline at fret coordinate @var{base}, a height of
 383 @var{height}, and a half thickness of @var{half-thickness}."
 384       (let* ((width (+ (- stop start) 1))
 385              (cp-left-width (+ (* width half-thickness) start))
 386              (cp-right-width (- stop (* width half-thickness)))
 387              (bottom-control-point-height
 388               (- base (- height half-thickness)))
 389              (top-control-point-height
 390               (- base height))
 391              (left-end-point
 392               (stencil-coordinates base start))
 393              (right-end-point
 394               (stencil-coordinates base stop))
 395              (left-upper-control-point
 396               (stencil-coordinates
 397                top-control-point-height cp-left-width))
 398              (left-lower-control-point
 399               (stencil-coordinates
 400                bottom-control-point-height cp-left-width))
 401              (right-upper-control-point
 402               (stencil-coordinates
 403                top-control-point-height cp-right-width))
 404              (right-lower-control-point
 405               (stencil-coordinates
 406                bottom-control-point-height cp-right-width)))
 407
 408         ;; order of bezier control points is:
 409         ;;   left cp low, left cp low, right cp low, right end low
 410         ;;   right cp high, left cp high
 411
 412         (list
 413               left-end-point
 414               left-lower-control-point
 415               right-lower-control-point
 416               right-end-point
 417
 418               right-upper-control-point
 419               left-upper-control-point)))
 420
 421     (define (draw-strings)
 422       "Draw the string lines for a fret diagram with
 423 @var{string-count} strings and frets as indicated in @var{fret-range}.
 424 Line thickness is given by @var{th}, fret & string spacing by
 425 @var{size}.  Orientation is determined by @var{orientation}."
 426
 427       (define (helper x)
 428         (if (null? (cdr x))
 429             (string-stencil (car x))
 430             (ly:stencil-add
 431              (string-stencil (car x))
 432              (helper (cdr x)))))
 433
 434       (let* ((string-list (map 1+ (iota string-count))))
 435         (helper string-list)))
 436
 437     (define (string-stencil string)
 438       "Make a stencil for @code{string}, given the fret-diagram
 439       overall parameters."
 440       (let* ((string-coordinate (- string-count string))
 441              (current-string-thickness
 442               (* th size (string-thickness string thickness-factor)))
 443              (fret-half-thickness (* size th 0.5))
 444              (half-string (* current-string-thickness 0.5))
 445              (start-coordinates
 446               (stencil-coordinates
 447                (- fret-half-thickness)
 448                (- (* size string-coordinate) half-string)))
 449              (end-coordinates
 450               (stencil-coordinates
 451                (+ fret-half-thickness (* size (1+ (fret-count fret-range))))
 452                (+ half-string (* size string-coordinate)))))
 453         (ly:round-filled-box
 454          (string-x-extent start-coordinates end-coordinates)
 455          (string-y-extent start-coordinates end-coordinates)
 456          (* th size))))
 457
 458     (define (draw-frets)
 459       "Draw the fret lines for a fret diagram with
 460 @var{string-count} strings and frets as indicated in @var{fret-range}.
 461 Line thickness is given by @var{th}, fret & string spacing by
 462 @var{size}.  Orientation is given by @var{orientation}."
 463       (define (helper x)
 464         (if (null? (cdr x))
 465             (fret-stencil (car x))
 466             (ly:stencil-add
 467              (fret-stencil (car x))
 468              (helper (cdr x)))))
 469
 470       (let ((fret-list (iota (1+ my-fret-count))))
 471         (helper fret-list)))
 472
 473     (define (fret-stencil fret)
 474       "Make a stencil for @code{fret}, given the
 475 fret-diagram overall parameters."
 476       (let* ((low-string-half-thickness
 477               (* 0.5
 478                  size
 479                  th
 480                  (string-thickness string-count thickness-factor)))
 481              (fret-half-thickness (* 0.5 size th))
 482              (start-coordinates
 483               (stencil-coordinates
 484                (* size fret)
 485                (- fret-half-thickness low-string-half-thickness)))
 486              (end-coordinates
 487               (stencil-coordinates
 488                (* size fret)
 489                (* size (1- string-count)))))
 490         (make-line-stencil
 491          (* size th)
 492          (car start-coordinates) (cdr start-coordinates)
 493          (car end-coordinates) (cdr end-coordinates))))
 494
 495     (define (draw-barre barre-list)
 496       "Create barre indications for a fret diagram"
 497       (if (not (null? barre-list))
 498           (let* ((string1 (caar barre-list))
 499                  (string2 (cadar barre-list))
 500                  (barre-fret (caddar barre-list))
 501                  (top-fret (cdr fret-range))
 502                  (low-fret (car fret-range))
 503                  (fret (1+ (- barre-fret low-fret)))
 504                  (barre-vertical-offset 0.5)
 505                  (dot-center-fret-coordinate (+ (1- fret) dot-position))
 506                  (barre-fret-coordinate
 507                   (+ dot-center-fret-coordinate
 508                      (* (- barre-vertical-offset 0.5) dot-radius)))
 509                  (barre-start-string-coordinate (- string-count string1))
 510                  (barre-end-string-coordinate (- string-count string2))
 511                  (scale-dot-radius (* size dot-radius))
 512                  (barre-type (assoc-get 'barre-type details 'curved))
 513                  (barre-stencil
 514                   (cond
 515                    ((eq? barre-type 'straight)
 516                     (make-straight-barre-stencil
 517                      barre-fret-coordinate
 518                      barre-start-string-coordinate
 519                      barre-end-string-coordinate
 520                      scale-dot-radius))
 521                    ((eq? barre-type 'curved)
 522                     (make-curved-barre-stencil
 523                      barre-fret-coordinate
 524                      barre-start-string-coordinate
 525                      barre-end-string-coordinate
 526                      scale-dot-radius)))))
 527             (if (not (null? (cdr barre-list)))
 528                 (ly:stencil-add
 529                  barre-stencil
 530                  (draw-barre (cdr barre-list)))
 531                 barre-stencil ))))
 532
 533     (define (make-straight-barre-stencil
 534              fret-coordinate
 535              start-string-coordinate
 536              end-string-coordinate
 537              half-thickness)
 538       "Create a straight barre stencil."
 539       (let ((start-point
 540              (stencil-coordinates
 541               (* size fret-coordinate)
 542               (* size start-string-coordinate)))
 543             (end-point
 544              (stencil-coordinates
 545               (* size fret-coordinate)
 546               (* size end-string-coordinate))))
 547         (make-line-stencil
 548          half-thickness
 549          (car start-point)
 550          (cdr start-point)
 551          (car end-point)
 552          (cdr end-point))))
 553
 554     (define (make-curved-barre-stencil
 555              fret-coordinate
 556              start-string-coordinate
 557              end-string-coordinate
 558              half-thickness)
 559       "Create a curved barre stencil."
 560       (let* ((bezier-thick 0.1)
 561              (bezier-height 0.5)
 562              (bezier-list
 563               (make-bezier-sandwich-list
 564                (* size start-string-coordinate)
 565                (* size end-string-coordinate)
 566                (* size fret-coordinate)
 567                (* size bezier-height)
 568                (* size bezier-thick))))
 569         (make-bezier-sandwich-stencil
 570          bezier-list
 571          (* size bezier-thick))))
 572
 573     (define (draw-dots dot-list)
 574       "Make dots for fret diagram."
 575
 576       (let* ( (scale-dot-radius (* size dot-radius))
 577               (scale-dot-thick (* size th))
 578               (default-dot-color (assoc-get 'dot-color details))
 579               (finger-label-padding 0.3)
 580               (dot-label-font-mag
 581                (* scale-dot-radius
 582                   (assoc-get 'dot-label-font-mag details 1.0)))
 583               (string-label-font-mag
 584                (* size
 585                   (assoc-get
 586                    'string-label-font-mag details
 587                    (cond ((or (eq? orientation 'landscape)
 588                               (eq? orientation 'opposing-landscape))
 589                           0.5)
 590                          (else  0.6)))))
 591               (mypair (car dot-list))
 592               (restlist (cdr dot-list))
 593               (string (car mypair))
 594               (fret (cadr mypair))
 595               (fret-coordinate (* size (+ (1- fret) dot-position)))
 596               (string-coordinate (* size (- string-count string)))
 597               (dot-coordinates
 598                (stencil-coordinates fret-coordinate string-coordinate))
 599               (extent (cons (- scale-dot-radius) scale-dot-radius))
 600               (finger (caddr mypair))
 601               (finger (if (number? finger) (number->string finger) finger))
 602               (parenthesized
 603                 (if (not (null? (dot-is-parenthesized mypair)))
 604                     (dot-is-parenthesized mypair)
 605                     #f))
 606               (parenthesis-color
 607                 (if (not (null? (default-paren-color mypair)))
 608                     (default-paren-color mypair)
 609                     #f))
 610               (inverted
 611                 (if (not (null? (dot-is-inverted mypair)))
 612                     (dot-is-inverted mypair)
 613                     #f))
 614               (dot-color-is-white?
 615                 (or inverted
 616                     (and (eq? default-dot-color 'white) (not inverted))))
 617               (what-color
 618                 (x11-color
 619                   (cond ((and inverted
 620                               (not (dot-has-color mypair))
 621                               (not (eq? default-dot-color 'white)))
 622                           (or default-dot-color 'black))
 623                         (dot-color-is-white?
 624                           (or (dot-has-color mypair) 'black))
 625                         (else
 626                           (or (dot-has-color mypair)
 627                               default-dot-color
 628                               'black)))))
 629               (inverted-stil
 630                 (lambda (color)
 631                   (ly:stencil-add
 632                     (stencil-with-color
 633                       (make-circle-stencil
 634                         scale-dot-radius scale-dot-thick #t)
 635                       color)
 636                     (stencil-with-color
 637                       (make-circle-stencil
 638                         (- scale-dot-radius (* 0.5 scale-dot-thick))
 639                         0  #t)
 640                       (x11-color 'white)))))
 641               (dot-stencil
 642                 (if dot-color-is-white?
 643                     (inverted-stil what-color)
 644                     (stencil-with-color
 645                       (make-circle-stencil
 646                          scale-dot-radius scale-dot-thick #t)
 647                       what-color)))
 648               (par-dot-stencil
 649                 (let ((paren-color
 650                         (if (and parenthesis-color
 651                                  (not (eq? default-dot-color 'white)))
 652                             (x11-color (or default-dot-color 'black))
 653                             what-color)))
 654                  (stencil-with-color
 655                    (parenthesize-stencil
 656                      dot-stencil      ;; stencil
 657                      (* size th 0.75) ;; half-thickness
 658                      (* 0.15 size)    ;;width
 659                      0                ;; angularity
 660                      paren-padding    ;; padding
 661                      )
 662                    paren-color)))
 663               (final-dot-stencil
 664                   (if parenthesized
 665                       par-dot-stencil
 666                       dot-stencil))
 667               (positioned-dot
 668                (ly:stencil-translate final-dot-stencil dot-coordinates))
 669               (labeled-dot-stencil
 670                (cond
 671                 ((or (eq? finger '())(eq? finger-code 'none))
 672                  positioned-dot)
 673                 ((eq? finger-code 'in-dot)
 674                  (let* ((finger-stil
 675                           (if (not (null? finger))
 676                               (sans-serif-stencil
 677                                  layout props dot-label-font-mag finger)
 678                               empty-stencil))
 679                         (finger-stil-length
 680                           (interval-length (ly:stencil-extent finger-stil X)))
 681                         (finger-stil-height
 682                           (interval-length (ly:stencil-extent finger-stil Y)))
 683                         (dot-stencil-radius
 684                           (/ (interval-length (ly:stencil-extent dot-stencil Y))
 685                              2))
 686                         (scale-factor
 687                           (/ dot-stencil-radius
 688                              ;; Calculate the radius of the circle through the
 689                              ;; corners of the box containing the finger-stil.
 690                              ;; Give it a little padding. The value, (* 2 th),
 691                              ;; is my choice
 692                              (+
 693                                (sqrt
 694                                   (+ (expt (/ finger-stil-length 2) 2)
 695                                      (expt (/ finger-stil-height 2) 2)))
 696                                 (* 2 th))))
 697                         (finger-label
 698                          (centered-stencil
 699                           (ly:stencil-scale
 700                            (sans-serif-stencil
 701                             layout props
 702                             dot-label-font-mag
 703                             finger)
 704                            scale-factor scale-factor))))
 705                    (ly:stencil-translate
 706                     (ly:stencil-add
 707                      final-dot-stencil
 708                      (if dot-color-is-white?
 709                          (stencil-with-color
 710                             finger-label
 711                             what-color)
 712                          (stencil-with-color finger-label white)))
 713                     dot-coordinates)))
 714                 ((eq? finger-code 'below-string)
 715                  (let* ((label-stencil
 716                          (centered-stencil
 717                           (sans-serif-stencil
 718                            layout props string-label-font-mag
 719                            finger)))
 720                         (label-fret-offset
 721                          (stencil-fretboard-offset
 722                           label-stencil 'fret orientation))
 723                         (label-fret-coordinate
 724                          (+ (* size
 725                                (+ 1 my-fret-count finger-label-padding))
 726                             label-fret-offset))
 727                         (label-string-coordinate string-coordinate)
 728                         (label-translation
 729                          (stencil-coordinates
 730                           label-fret-coordinate
 731                           label-string-coordinate)))
 732                    (ly:stencil-add
 733                     positioned-dot
 734                     (ly:stencil-translate
 735                      label-stencil
 736                      label-translation))))
 737                 (else ;unknown finger-code
 738                  positioned-dot))))
 739         (if (null? restlist)
 740             labeled-dot-stencil
 741             (ly:stencil-add
 742              (draw-dots restlist)
 743              labeled-dot-stencil))))
 744
 745     (define (draw-thick-zero-fret)
 746       "Draw a thick zeroth fret for a fret diagram whose base fret is 1."
 747       (let* ((half-lowest-string-thickness
 748               (* 0.5 th (string-thickness string-count thickness-factor)))
 749              (half-thick (* 0.5 sth))
 750              (top-fret-thick
 751               (* sth (assoc-get 'top-fret-thickness details 3.0)))
 752              (start-string-coordinate (- half-lowest-string-thickness))
 753              (end-string-coordinate (+ (* size (1- string-count)) half-thick))
 754              (start-fret-coordinate half-thick)
 755              (end-fret-coordinate (- half-thick top-fret-thick))
 756              (lower-left
 757               (stencil-coordinates
 758                start-fret-coordinate start-string-coordinate))
 759              (upper-right
 760               (stencil-coordinates
 761                end-fret-coordinate end-string-coordinate)))
 762         (ly:round-filled-box
 763          ;; Put limits in order, or else the intervals are considered empty
 764          (ordered-cons (car lower-left) (car upper-right))
 765          (ordered-cons (cdr lower-left) (cdr upper-right))
 766          sth)))
 767
 768     (define (draw-xo xo-list)
 769       "Put open and mute string indications on diagram, as contained in
 770 @var{xo-list}."
 771       (let* ((xo-font-mag
 772               (assoc-get 'xo-font-magnification details
 773                          (cond ((or (eq? orientation 'landscape)
 774                                     (eq? orientation 'opposing-landscape))
 775                                 0.4)
 776                                (else 0.4))))
 777              (mypair (car xo-list))
 778              (restlist (cdr xo-list))
 779              (glyph-string (if (eq? (car mypair) 'mute)
 780                                (assoc-get 'mute-string details "X")
 781                                (assoc-get 'open-string details "O")))
 782              (glyph-string-coordinate (* (- string-count (cadr mypair)) size))
 783              (glyph-stencil
 784               (centered-stencil
 785                (sans-serif-stencil
 786                 layout props (* size xo-font-mag) glyph-string)))
 787              (glyph-stencil-coordinates
 788               (stencil-coordinates 0 glyph-string-coordinate))
 789              (positioned-glyph
 790               (ly:stencil-translate
 791                glyph-stencil
 792                glyph-stencil-coordinates)))
 793         (if (null? restlist)
 794             positioned-glyph
 795             (ly:stencil-add
 796              positioned-glyph
 797              (draw-xo restlist)))))
 798
 799     (define (draw-capo fret)
 800       "Draw a capo indicator across the full width of the fret-board
 801 at @var{fret}."
 802       (let* ((capo-thick
 803               (* size (assoc-get 'capo-thickness details 0.5)))
 804              (half-thick (* capo-thick 0.5))
 805              (last-string-position 0)
 806              (first-string-position (* size (- string-count 1)))
 807              (fret-position ( * size (1- (+ dot-position fret))))
 808              (start-point
 809               (stencil-coordinates
 810                fret-position
 811                first-string-position))
 812              (end-point
 813               (stencil-coordinates
 814                fret-position
 815                last-string-position)))
 816         (make-line-stencil
 817          capo-thick
 818          (car start-point) (cdr start-point)
 819          (car end-point) (cdr end-point))))
 820
 821     (define (label-fret fret-range)
 822       "Label the base fret on a fret diagram"
 823       (let* ((base-fret (car fret-range))
 824              (label-font-mag (assoc-get 'fret-label-font-mag details 0.5))
 825              (label-space (* 0.5 size))
 826              (label-dir (assoc-get 'label-dir details RIGHT))
 827              (label-vertical-offset
 828               (assoc-get 'fret-label-vertical-offset details 0))
 829              (label-horizontal-offset
 830               (assoc-get 'fret-label-horizontal-offset details 0))
 831              (number-type
 832               (assoc-get 'number-type details 'roman-lower))
 833              (label-text
 834               (number-format number-type base-fret
 835                              (assoc-get 'fret-label-custom-format
 836                                          details "~a")))
 837              (label-stencil
 838               (centered-stencil
 839                (sans-serif-stencil
 840                 layout props (* size label-font-mag) label-text)))
 841              (label-half-width
 842               (stencil-fretboard-offset
 843                label-stencil
 844                'string
 845                orientation))
 846              (label-outside-diagram
 847                (+ label-space
 848                   (* size label-horizontal-offset)
 849                   label-half-width)))
 850         (ly:stencil-translate
 851          label-stencil
 852          (stencil-coordinates
 853           (* size (+ 1.0 label-vertical-offset))
 854           (if (eq? label-dir LEFT)
 855               (- label-outside-diagram)
 856               (+ (* size (1- string-count)) label-outside-diagram))))))
 857
 858     ;; Here is the body of make-fret-diagram
 859
 860     (set! fret-diagram-stencil
 861           (ly:stencil-add (draw-strings) (draw-frets)))
 862     (if (and (not (null? barre-list))
 863              (not (eq? 'none barre-type)))
 864         (set! fret-diagram-stencil
 865               (ly:stencil-add
 866                (draw-barre barre-list)
 867                fret-diagram-stencil)))
 868     (if (not (null? dot-list))
 869         (set! fret-diagram-stencil
 870               (ly:stencil-add
 871                fret-diagram-stencil
 872                (draw-dots dot-list))))
 873     (if (= (car fret-range) 1)
 874         (set! fret-diagram-stencil
 875               (ly:stencil-add
 876                fret-diagram-stencil
 877                (draw-thick-zero-fret))))
 878     (if (not (null? xo-list))
 879         (let* ((diagram-fret-top
 880                 (car (stencil-fretboard-extent
 881                       fret-diagram-stencil
 882                       'fret
 883                       orientation)))
 884                (xo-stencil (draw-xo xo-list))
 885                (xo-fret-offset
 886                 (stencil-fretboard-offset
 887                  xo-stencil 'fret orientation))
 888                (xo-stencil-offset
 889                 (stencil-coordinate-offset
 890                  (- diagram-fret-top
 891                     xo-fret-offset
 892                     (* size xo-padding))
 893                  0)))
 894           (set! fret-diagram-stencil
 895                 (ly:stencil-add
 896                  fret-diagram-stencil
 897                  (ly:stencil-translate
 898                   xo-stencil
 899                   xo-stencil-offset)))))
 900     (if (> capo-fret 0)
 901         (set! fret-diagram-stencil
 902               (ly:stencil-add
 903                fret-diagram-stencil
 904                (draw-capo capo-fret))))
 905     (if (> (car fret-range) 1)
 906         (set! fret-diagram-stencil
 907               (ly:stencil-add
 908                fret-diagram-stencil
 909                (label-fret fret-range))))
 910     (ly:stencil-aligned-to fret-diagram-stencil X alignment)))
 911
 912 (define (fret-parse-definition-string props definition-string)
 913   "Parse a fret diagram string and return a pair containing:
 914 @var{props}, modified as necessary by the definition-string
 915 a fret-indication list with the appropriate values"
 916   (let* ((fret-count 4)
 917          (string-count 6)
 918          (fret-range (cons 1 fret-count))
 919          (barre-list '())
 920          (dot-list '())
 921          (xo-list '())
 922          (output-list '())
 923          (new-props '())
 924          (details (merge-details 'fret-diagram-details props '()))
 925          ;; remove whitespace-characters from definition-string
 926          (cleared-string (remove-whitespace definition-string))
 927          (items (string-split cleared-string #\;)))
 928     (let parse-item ((myitems items))
 929       (if (not (null? (cdr myitems)))
 930           (let ((test-string (car myitems)))
 931             (case (car (string->list (substring test-string 0 1)))
 932               ((#\s) (let ((size (get-numeric-from-key test-string)))
 933                        (set! props (prepend-alist-chain 'size size props))))
 934               ((#\t) (let ((th (get-numeric-from-key test-string)))
 935                        (set! props (prepend-alist-chain 'thickness th props))))
 936               ((#\f) (let* ((finger-code (get-numeric-from-key test-string))
 937                             (finger-id (case finger-code
 938                                          ((0) 'none)
 939                                          ((1) 'in-dot)
 940                                          ((2) 'below-string))))
 941                        (set! details
 942                              (acons 'finger-code finger-id details))))
 943               ((#\c) (set! output-list
 944                            (cons-fret
 945                             (cons
 946                              'barre
 947                              (numerify
 948                               (string-split (substring test-string 2) #\-)))
 949                             output-list)))
 950               ((#\h) (let ((fret-count (get-numeric-from-key test-string)))
 951                        (set! details
 952                              (acons 'fret-count fret-count details))))
 953               ((#\w) (let ((string-count (get-numeric-from-key test-string)))
 954                        (set! details
 955                              (acons 'string-count string-count details))))
 956               ((#\d) (let ((dot-size (get-numeric-from-key test-string)))
 957                        (set! details
 958                              (acons 'dot-radius dot-size details))))
 959               ((#\p) (let ((dot-position (get-numeric-from-key test-string)))
 960                        (set! details
 961                              (acons 'dot-position dot-position details))))
 962               (else
 963                (let* ((this-list (string-split test-string #\-))
 964                       (fret-number (string->number (car this-list))))
 965                  ;; If none of the above applies, `fret-number' needs to be a
 966                  ;; number. Throw an error, if not.
 967                  (if (not fret-number)
 968                    (ly:error
 969                      "Unhandled entry in fret-diagrams \"~a\" in \"~a\""
 970                      (car this-list)
 971                      test-string))
 972                  (if (string->number (cadr this-list))
 973                      (set! output-list
 974                            (cons-fret
 975                             (cons 'place-fret (numerify this-list))
 976                             output-list))
 977                      (if (equal? (cadr this-list) "x" )
 978                          (set! output-list
 979                                (cons-fret
 980                                 (list 'mute fret-number)
 981                                 output-list))
 982                          (set! output-list
 983                                (cons-fret
 984                                 (list 'open fret-number)
 985                                 output-list)))))))
 986             (parse-item (cdr myitems)))))
 987     ;; add the modified details
 988     (set! props
 989           (prepend-alist-chain 'fret-diagram-details details props))
 990     `(,props . ,output-list))) ;ugh -- hard-coded spell -- procedure better
 991
 992 (define-public
 993   (fret-parse-terse-definition-string props definition-string)
 994   "Parse a fret diagram string that uses terse syntax;
 995 return a pair containing:
 996 @var{props}, modified to include the string-count determined by the
 997 definition-string, and
 998 a fret-indication list with the appropriate values"
 999   ;; TODO -- change syntax to fret\string-finger
1000
1001   (let* ((details (merge-details 'fret-diagram-details props '()))
1002          (barre-start-list '())
1003          (output-list '())
1004          (new-props '())
1005          (items (string-split definition-string #\;))
1006          (string-count (- (length items) 1)))
1007     (let parse-item ((myitems items))
1008       (if (not (null? (cdr myitems)))
1009           (let* ((test-string (car myitems))
1010                  (current-string (- (length myitems) 1))
1011                  (indicators (string-split test-string #\ )))
1012             (let parse-indicators ((myindicators indicators))
1013               (if (not (eq? '() myindicators))
1014                   (let* ((this-list (string-split (car myindicators) #\-))
1015                          (max-element-index (- (length this-list) 1))
1016                          (last-element
1017                           (car (list-tail this-list max-element-index)))
1018                          (fret
1019                           (if (string->number (car this-list))
1020                               (string->number (car this-list))
1021                               (car this-list))))
1022                     (if (equal? last-element "(")
1023                         (begin
1024                           (set! barre-start-list
1025                                 (cons-fret (list current-string fret)
1026                                            barre-start-list))
1027                           (set! this-list
1028                                 (list-head this-list max-element-index))))
1029                     (if (equal? last-element ")")
1030                         (let* ((this-barre
1031                                 (get-sub-list fret barre-start-list))
1032                                (insert-index (- (length this-barre) 1)))
1033                           (set! output-list
1034                                 (cons-fret (cons* 'barre
1035                                                   (car this-barre)
1036                                                   current-string
1037                                                   (cdr this-barre))
1038                                            output-list))
1039                           (set! this-list
1040                                 (list-head this-list max-element-index))))
1041                     (if (number? fret)
1042                         (set!
1043                          output-list
1044                          (cons-fret (cons*
1045                                      'place-fret
1046                                      current-string
1047                                      (drop-paren (numerify this-list)))
1048                                     output-list))
1049                         (if (equal? (car this-list) "x" )
1050                             (set!
1051                              output-list
1052                              (cons-fret
1053                               (list 'mute current-string)
1054                               output-list))
1055                             (set!
1056                              output-list
1057                              (cons-fret
1058                               (list 'open current-string)
1059                               output-list))))
1060                     (parse-indicators (cdr myindicators)))))
1061             (parse-item (cdr myitems)))))
1062     (set! details (acons 'string-count string-count details))
1063     (set! props (prepend-alist-chain 'fret-diagram-details details props))
1064     `(,props . ,output-list))) ; ugh -- hard coded; proc is better
1065
1066
1067 (define-markup-command
1068   (fret-diagram-verbose layout props marking-list)
1069   (pair?) ; argument type (list, but use pair? for speed)
1070   #:category instrument-specific-markup ; markup type
1071   #:properties ((align-dir -0.4) ; properties and defaults
1072                 (size 1.0)
1073                 (fret-diagram-details)
1074                 (thickness 0.5))
1075   "Make a fret diagram containing the symbols indicated in @var{marking-list}.
1076
1077   For example,
1078
1079 @example
1080 \\markup \\fret-diagram-verbose
1081   #'((mute 6) (mute 5) (open 4)
1082      (place-fret 3 2) (place-fret 2 3) (place-fret 1 2))
1083 @end example
1084
1085 @noindent
1086 produces a standard D@tie{}chord diagram without fingering indications.
1087
1088 Possible elements in @var{marking-list}:
1089
1090 @table @code
1091 @item (mute @var{string-number})
1092 Place a small @q{x} at the top of string @var{string-number}.
1093
1094 @item (open @var{string-number})
1095 Place a small @q{o} at the top of string @var{string-number}.
1096
1097 @item (barre @var{start-string} @var{end-string} @var{fret-number})
1098 Place a barre indicator (much like a tie) from string @var{start-string}
1099 to string @var{end-string} at fret @var{fret-number}.
1100
1101 @item (capo @var{fret-number})
1102 Place a capo indicator (a large solid bar) across the entire fretboard
1103 at fret location @var{fret-number}.  Also, set fret @var{fret-number}
1104 to be the lowest fret on the fret diagram.
1105 @item
1106 (place-fret @var{string-number}
1107             @var{fret-number}
1108             [@var{finger-value}]
1109             [@var{color-modifier}]
1110             [@var{color}]
1111             [@code{'parenthesized} [@code{'default-paren-color}]])
1112 Place a fret playing indication on string @var{string-number} at fret
1113 @var{fret-number} with an optional fingering label @var{finger-value},
1114 an optional color modifier @var{color-modifier}, an optional color
1115 @var{color}, an optional parenthesis @code{'parenthesized} and an
1116 optional paranthesis color @code{'default-paren-color}.
1117 By default, the fret playing indicator is a solid dot.  This can be
1118 globally changed by setting the value of the variable @var{dot-color}
1119 or for a single dot by setting the value of @var{color}.  The dot can
1120 be parenthesized by adding @code{'parenthesized}.  By default the
1121 color for the parenthesis is taken from the dot.  Adding
1122 @code{'default-paren-color} will take the parenthesis-color from the
1123 global @var{dot-color}, as a fall-back black will be used.
1124 Setting @var{color-modifier} to @code{inverted} inverts the dot color
1125 for a specific fingering.
1126 The values for @var{string-number}, @var{fret-number}, and the optional
1127 @var{finger} should be entered first in that order.
1128 The order of the other optional arguments does not matter.
1129 If the @var{finger} part of the @code{place-fret} element is present,
1130 @var{finger-value} will be displayed according to the setting of the
1131 variable @var{finger-code}.  There is no limit to the number of fret
1132 indications per string.
1133 @end table"
1134
1135   (make-fret-diagram layout props marking-list))
1136
1137
1138 (define-markup-command (fret-diagram layout props definition-string)
1139   (string?) ; argument type
1140   #:category instrument-specific-markup ; markup category
1141   #:properties (fret-diagram-verbose-markup) ; properties and defaults
1142   "Make a (guitar) fret diagram.  For example, say
1143
1144 @example
1145 \\markup \\fret-diagram #\"s:0.75;6-x;5-x;4-o;3-2;2-3;1-2;\"
1146 @end example
1147
1148 @noindent
1149 for fret spacing 3/4 of staff space, D chord diagram
1150
1151 Syntax rules for @var{definition-string}:
1152 @itemize @minus
1153
1154 @item
1155 Diagram items are separated by semicolons.
1156
1157 @item
1158 Possible items:
1159
1160 @itemize @bullet
1161 @item
1162 @code{s:}@var{number} -- Set the fret spacing of the diagram (in staff
1163 spaces).
1164 Default:@tie{}1.
1165
1166 @item
1167 @code{t:}@var{number} -- Set the line thickness (relative to normal
1168 line thickness).
1169 Default:@tie{}0.5.
1170
1171 @item
1172 @code{h:}@var{number} -- Set the height of the diagram in frets.
1173 Default:@tie{}4.
1174
1175 @item
1176 @code{w:}@var{number} -- Set the width of the diagram in strings.
1177 Default:@tie{}6.
1178
1179 @item
1180 @code{f:}@var{number} -- Set fingering label type
1181  (0@tie{}= none, 1@tie{}= in circle on string, 2@tie{}= below string).
1182 Default:@tie{}0.
1183
1184 @item
1185 @code{d:}@var{number} -- Set radius of dot, in terms of fret spacing.
1186 Default:@tie{}0.25.
1187
1188 @item
1189 @code{p:}@var{number} -- Set the position of the dot in the fret space.
1190 0.5 is centered; 1@tie{}is on lower fret bar, 0@tie{}is on upper fret bar.
1191 Default:@tie{}0.6.
1192
1193 @item
1194 @code{c:}@var{string1}@code{-}@var{string2}@code{-}@var{fret} -- Include a
1195 barre mark from @var{string1} to @var{string2} on @var{fret}.
1196
1197 @item
1198 @var{string}@code{-}@var{fret} -- Place a dot on @var{string} at @var{fret}.
1199 If @var{fret} is @samp{o}, @var{string} is identified as open.
1200 If @var{fret} is @samp{x}, @var{string} is identified as muted.
1201
1202 @item
1203 @var{string}@code{-}@var{fret}@code{-}@var{fingering} -- Place a dot on
1204 @var{string} at @var{fret}, and label with @var{fingering} as defined
1205 by the @code{f:} code.
1206 @end itemize
1207
1208 @item
1209 Note: There is no limit to the number of fret indications per string.
1210 @end itemize"
1211   (let ((definition-list
1212           (fret-parse-definition-string props definition-string)))
1213     (fret-diagram-verbose-markup
1214      layout (car definition-list) (cdr definition-list))))
1215
1216 (define-markup-command
1217   (fret-diagram-terse layout props definition-string)
1218   (string?) ; argument type
1219   #:category instrument-specific-markup ; markup category
1220   #:properties (fret-diagram-verbose-markup) ; properties
1221   "Make a fret diagram markup using terse string-based syntax.
1222
1223 Here is an example
1224
1225 @example
1226 \\markup \\fret-diagram-terse #\"x;x;o;2;3;2;\"
1227 @end example
1228
1229 @noindent
1230 for a D@tie{}chord diagram.
1231
1232 Syntax rules for @var{definition-string}:
1233
1234 @itemize @bullet
1235
1236 @item
1237 Strings are terminated by semicolons; the number of semicolons
1238 is the number of strings in the diagram.
1239
1240 @item
1241 Mute strings are indicated by @samp{x}.
1242
1243 @item
1244 Open strings are indicated by @samp{o}.
1245
1246 @item
1247 A number indicates a fret indication at that fret.
1248
1249 @item
1250 If there are multiple fret indicators desired on a string, they
1251 should be separated by spaces.
1252
1253 @item
1254 Fingerings are given by following the fret number with a @w{@code{-},}
1255 followed by the finger indicator, e.g. @samp{3-2} for playing the third
1256 fret with the second finger.
1257
1258 @item
1259 Where a barre indicator is desired, follow the fret (or fingering) symbol
1260 with @w{@code{-(}} to start a barre and @w{@code{-)}} to end the barre.
1261
1262 @end itemize"
1263   ;; TODO -- change syntax to fret\string-finger
1264   (let ((definition-list
1265           (fret-parse-terse-definition-string props definition-string)))
1266     (fret-diagram-verbose-markup layout
1267                                  (car definition-list)
1268                                  (cdr definition-list))))