Add simple command line interface.

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))