diff options
| -rw-r--r-- | scales/ui.scm | 89 | ||||
| -rwxr-xr-x | scripts/scales.in (renamed from scripts/scales) | 15 |
2 files changed, 92 insertions, 12 deletions
diff --git a/scales/ui.scm b/scales/ui.scm new file mode 100644 index 0000000..9382b24 --- /dev/null +++ b/scales/ui.scm @@ -0,0 +1,89 @@ +;;; scales - Generate musical scale patterns +;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> +;;; +;;; This program is free software: you can redistribute it and/or +;;; modify it under the terms of the GNU Affero General Public License +;;; as published by the Free Software Foundation, either version 3 of +;;; the License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Affero General Public License for more details. +;;; +;;; You should have received a copy of the GNU Affero General Public +;;; License along with this program. If not, see +;;; <http://www.gnu.org/licenses/>. + +(define-module (scales ui) + #:use-module (ice-9 getopt-long) + #:use-module (scales fretboard) + #:use-module (scales scales) + #:export (main)) + +(define (lookup-tuning tuning) + (catch #t + (lambda _ + (module-ref (resolve-interface '(scales fretboard)) + (symbol-append 'tuning- tuning))) + (lambda _ tuning))) + +(define (lookup-scale scale) + (catch #t + (lambda _ + (module-ref (resolve-interface '(scales scales)) scale)) + (lambda _ (steps->scale scale)))) + +(define (main args) + (let* ((option-spec '((version (single-char #\v) (value #f)) + (help (single-char #\h) (value #f)) + (format (single-char #\f) (value #t)) + (tuning (single-char #\t) (value #t)) + (scale (single-char #\s) (value #t)) + (root (single-char #\r) (value #t)))) + (options (getopt-long args option-spec)) + (help-wanted (option-ref options 'help #f)) + (version-wanted (option-ref options 'version #f)) + (format (option-ref options 'format "text")) + (tuning (call-with-input-string + (option-ref options 'tuning "guitar") + read)) + (scale (call-with-input-string + (option-ref options 'scale "aeolian") + read)) + (root (option-ref options 'root "c"))) + (if (or version-wanted help-wanted) + (begin + (if version-wanted + (display "scales version 0.0.0\n")) + (if help-wanted + (display "\ +scales [options] + -v, --version Display version. + -h, --help Display this help. + -f, --format=text|svg Print as text (default) or as SVG. + -t, --tuning=EXPR Use string tuning EXPR. This can be a + defined tuning such as \"guitar\" or + \"grand-stick-matched-reciprocal-6+6\", or a + list of note names, e.g. \"(d a d g b e)\". + -s, --scale=SCALE Highlight notes from scale SCALE. This can + be a scale name like \"phrygian\" or a list + of steps, e.g. \"(1 2 2 2 1 2 2)\". + -r, --root=NOTE The root note of the scale, e.g. \"fis\" for + f sharp. Defaults to \"c\". + +"))) + (let ((scale (lookup-scale scale)) + (tuning (lookup-tuning tuning)) + (root (string->symbol root)) + (show (case (string->symbol format) + ((svg) (compose display svg-fretboard)) + (else print-fretboard)))) + + ;; Deal with tunings having multiple blocks of strings + ;; (e.g. the Stick tunings) + (if (pair? (car tuning)) + (for-each show (map (lambda (group) + (fretboard group (scale root))) + tuning)) + (show (fretboard tuning (scale root)))))))) diff --git a/scripts/scales b/scripts/scales.in index 7bd74aa..3af6437 100755 --- a/scripts/scales +++ b/scripts/scales.in @@ -1,4 +1,5 @@ #!/home/rekado/.guix-profile/bin/guile -s +-*- scheme -*- !# ;;; scales - Generate musical scale patterns @@ -18,15 +19,5 @@ ;;; License along with this program. If not, see ;;; <http://www.gnu.org/licenses/>. -(use-modules (scales scales) - (scales fretboard)) - -(display "Guitar: E Aeolian\n") -(print-fretboard (fretboard tuning-guitar (aeolian 'e) 7 5)) -(newline)(newline) - -(display "Stick: E Aeolian\n") -(print-stick - (map (lambda (string-group) - (fretboard string-group (aeolian 'e) 7 5)) - tuning-grand-stick-matched-reciprocal-6+6)) +(use-modules (scales ui)) +(main (command-line)) |