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