1 files changed, 116 insertions, 0 deletions
diff --git a/sly/cli.scm b/sly/cli.scm
new file mode 100644
index 0000000..b4040d0
--- /dev/null
+++ b/sly/cli.scm
@@ -0,0 +1,116 @@
+;;; Sly
+;;; Copyright (C) 2016 David Thompson <davet@gnu.org>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU 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
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (sly cli)
+  #:use-module (ice-9 format)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-37)
+  #:use-module (sly game)
+  #:use-module (sly input keyboard)
+  #:use-module (sly repl)
+  #:use-module (sly window)
+  #:export (sly-main))
+
+(define-syntax-rule (push! var x)
+  (set! var (cons x var)))
+
+(define (make-sly-module)
+  (let ((module (make-fresh-user-module)))
+    (module-use! module (resolve-interface '(sly)))
+    module))
+
+(define (directory? file-name)
+  (and (file-exists? file-name)
+       (eq? 'directory (stat:type (stat file-name)))))
+
+(define (directory-excursion thunk)
+  (let ((cwd (getcwd)))
+    (dynamic-wind
+      (const #t)
+      thunk
+      (lambda ()
+        (chdir cwd)))))
+
+(define (play-game directory develop?)
+  (let ((abs-dir (canonicalize-path directory))
+        (module (make-sly-module)))
+    (set! %fresh-auto-compile #t)
+    (set! %load-should-auto-compile #t)
+    (push! %load-path abs-dir)
+    (push! %load-compiled-path abs-dir)
+    (add-hook! key-press-hook (lambda (key)
+                                (when (eq? key 'escape)
+                                  (stop-game-loop))))
+    (add-hook! window-close-hook stop-game-loop)
+    (directory-excursion
+     (lambda ()
+       (chdir directory)
+       (init-window)
+       (let ((game (save-module-excursion
+                    (lambda ()
+                      (set-current-module module)
+                      (load (canonicalize-path "main.scm"))))))
+         (when develop?
+           (start-sly-repl))
+         (with-window (game-window game)
+           (run-game-loop (game-scene game))))))))
+
+(define %default-options
+  '((develop? #f)))
+
+(define %options
+  (list (option '(#\h "help") #f #f
+                (lambda _
+                  (show-help)
+                  (exit 0)))
+        (option '(#\d "develop") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'develop? #t result)))))
+
+(define (show-help)
+  (display "Usage: sly [OPTION]... GAME-DIRECTORY
+Run the Sly game located in GAME-DIRECTORY.\n")
+  (display "
+  -d, --develop          Run in development mode")
+  (newline))
+
+(define (sly-main args)
+  (let* ((opts (args-fold args
+                          %options
+                          (lambda (opt name arg result)
+                            (format #t "unrecognized option '~a'~%" name)
+                            (exit 1))
+                          (lambda (op result)
+                            (let ((game-dir (assoc-ref result 'game-dir)))
+                              (if game-dir
+                                  (begin
+                                    (format #t "extraneous operand '~a'~%" op)
+                                    (exit 1))
+                                  (alist-cons 'game-dir op result))))
+                          '()))
+         (game-dir (assoc-ref opts 'game-dir))
+         (develop? (assoc-ref opts 'develop?)))
+    (cond
+   ((not game-dir)
+    (display "error: no game directory specified\n")
+    (exit 1))
+   ((directory? game-dir)
+    (format #t "loading game in '~a'~%" game-dir)
+    (play-game game-dir develop?))
+   (else
+    (format #t "error: directory '~a' does not exist~%" game-dir)
+    (exit 1)))))