summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2016-08-11 22:50:17 -0400
committerDavid Thompson <dthompson2@worcester.edu>2016-08-11 22:50:17 -0400
commit54f85fc9ef316a355e432a7461aac36282742614 (patch)
treedd0ca233933e6fda348936e76cbf4d0784924e2f
parenta06ff79a3276fb336fc00ff8c4c9ab1209f3441f (diff)
Add 'sly' CLI program.
* scripts/sly.in: New file. * sly/cli.scm: New file. * Makefile.am (SOURCES): Add it. * configure.ac: Process scripts/sly.in to produce sly executable. * pre-inst-env.in: Fix $PATH to include scripts directory.
-rw-r--r--.gitignore1
-rw-r--r--Makefile.am1
-rw-r--r--configure.ac2
-rw-r--r--pre-inst-env.in2
-rw-r--r--scripts/sly.in24
-rw-r--r--sly/cli.scm116
6 files changed, 144 insertions, 2 deletions
diff --git a/.gitignore b/.gitignore
index 435ffa7..190a3c5 100644
--- a/.gitignore
+++ b/.gitignore
@@ -30,3 +30,4 @@ Makefile.in
/pre-inst-env
/sly/config.scm
/sandbox
+/scripts/sly
diff --git a/Makefile.am b/Makefile.am
index 0db0854..e499936 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -61,6 +61,7 @@ SOURCES = \
sly/fps.scm \
sly/live-reload.scm \
sly/repl.scm \
+ sly/cli.scm \
$(WRAPPER_SOURCES) \
sly.scm
diff --git a/configure.ac b/configure.ac
index ff0f6e1..0df52c2 100644
--- a/configure.ac
+++ b/configure.ac
@@ -9,7 +9,7 @@ AM_SILENT_RULES([yes])
AC_PATH_PROG([GUILE], [guile])
AC_CONFIG_FILES([Makefile doc/Makefile examples/Makefile data/Makefile])
AC_CONFIG_FILES([sly/config.scm])
-AC_CONFIG_FILES([sandbox], [chmod +x sandbox])
+AC_CONFIG_FILES([scripts/sly], [chmod +x scripts/sly])
AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
# Prepare a version of $datadir that does not contain references to
diff --git a/pre-inst-env.in b/pre-inst-env.in
index bf3588a..d33447a 100644
--- a/pre-inst-env.in
+++ b/pre-inst-env.in
@@ -24,7 +24,7 @@ GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_
GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH"
export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH
-PATH="$abs_top_builddir:$PATH"
+PATH="$abs_top_builddir/scripts:$PATH"
export PATH
SLY_DATADIR="$abs_top_builddir/data"
diff --git a/scripts/sly.in b/scripts/sly.in
new file mode 100644
index 0000000..b95cee4
--- /dev/null
+++ b/scripts/sly.in
@@ -0,0 +1,24 @@
+#!@GUILE@ --no-auto-compile
+-*- scheme -*-
+!#
+
+;;; 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/>.
+
+(use-modules (sly cli))
+
+(sly-main (cdr (command-line)))
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)))))