diff options
| -rw-r--r-- | scales/fretboard.scm | 52 |
1 files changed, 51 insertions, 1 deletions
diff --git a/scales/fretboard.scm b/scales/fretboard.scm index 6802b45..92b3de6 100644 --- a/scales/fretboard.scm +++ b/scales/fretboard.scm @@ -22,6 +22,7 @@ #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) #:use-module (scales utils) + #:use-module (scales svg) #:export (tuning-guitar tuning-grand-stick-matched-reciprocal-6+6 @@ -29,7 +30,9 @@ fretboard print-fretboard - print-stick)) + print-stick + + svg-fretboard)) ;;; Tunings @@ -98,3 +101,50 @@ are indicated for as many FRETS as specified." (for-each (compose (lambda _ (format #t "\n")) print-fretboard) fretboards)) + + +;;; SVG + +;; TODO: rewrite to draw strings first, then add markers on top. + +(define (svg-fret height width fret) + (let ((note (fret-note fret))) + `(g ,(list + ;; String + (line 0 (/ height 2) + width (/ height 2) + "stroke-width: 2; stroke: #000") + ;; Fret + (line width 0 + width height + "stroke-width: 3; stroke: #000") + (if note + (list + ;; Position marker + (circle (/ width 2) (/ height 2) + (- (/ height 2) 4) + (if (zero? (scale-note-offset note)) + "fill: #faafaa; stroke: #888" + "fill: #fff; stroke: #aaa")) + ;; Note name + (text (/ width 2) (/ height 2) + (format #f "~a" + (if (zero? (scale-note-offset note)) + (string-upcase (symbol->string (scale-note-note note))) + (scale-note-note note))) + "text-anchor: middle; alignment-baseline: middle")) + '()))))) + +(define (svg-frets frets) + `(g ,(map (match-lambda + ((offset fret) + (translate offset 0 (svg-fret 32 64 fret)))) + (zip (iota (length frets) 0 64) + frets)))) + +(define (svg-fretboard fretboard) + (svg (map (match-lambda + ((offset frets) + (translate 0 offset (svg-frets frets)))) + (zip (iota (length fretboard) 0 32) + fretboard)))) |