blob: b4040d08f876178e6c5901d7ccd737f5dbda7f94 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
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)))))
|
