~octaspire/crates2

ref: d3d9b5a552ee27e1197a7e77bab298b4f51edd98 crates2/src/main.lisp -rw-r--r-- 3.7 KiB
d3d9b5a5octaspire Fix few things 11 months ago
                                                                                
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
117
118
119
120
121
122
123
124
125
126
127
128
129
;; Octaspire Crates 2 - Puzzle Game
;; Copyright 2020 octaspire.com
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
(in-package :crates2)

(defparameter *verbose* 0)
(defparameter *version-major* 0)
(defparameter *version-minor* 1)
(defparameter *version-patch* 0)
(defparameter *errors* nil)
(defparameter *input* nil)
(defparameter *level-number* -1)
(defparameter *running* t)
(defparameter *level* nil)
(defparameter *next-level* nil)
(defparameter *level-width* 20)
(defparameter *level-height* 10)

(defun verbose-parser (x)
  (setf *verbose* (parse-integer x)))

(defun get-current-level()
  (unless *level*
    (load-next-level))
  *level*)

(defun runningp ()
  *running*)

(defun running (value)
  (setf *running* value))

(opts:define-opts
  (:name :help
   :description "Show this usage information and quit"
   :short #\h
   :long "help")
  (:name :verbose
   :description "Make verbose"
   :short #\v
   :long "verbose"
   :arg-parser #'verbose-parser)
  (:name :version
   :description "Show version information"
   :long "version")
  (:name :fullscreen
   :description "Run in fullscreen mode"
   :long "fullscreen"))

(defun dbg (fmt &rest args)
  (when (> *verbose* 0)
    (format t fmt args)))

(defun run ()
  (unless *errors*
    (request-next-level)
    (loop while (runningp)
            do (ui-render *level*)
               (let ((input (ui-input)))
                 (when input
                   (setf *input* (cons input *input*))))
               (update *level*)
               (when *next-level*
                 (load-next-level))
               (sleep 2))))

(defun usage ()
  (opts:describe
   :prefix "Puzzle game"
   :usage-of "crates2"))

(defun version ()
  (format t "crates ~A.~A.~A~%" *version-major* *version-minor* *version-patch*))

(defun unknown-option (condition)
  (format t "Error: option '~A' is unknown~%" (opts:option condition))
  (setf *errors* t)
  (invoke-restart 'opts:skip-option))

(defun parser-error (condition)
  (format t "Argument Parse Error: ~A~%" (opts:option condition))
  (setf *errors* t)
  (invoke-restart 'opts:skip-option))

(defmacro cond-option (options &rest clauses)
  (alexandria:with-gensyms
      (option value opts-not-empty)
    `(let ((,opts-not-empty (or ,options (list nil nil))))
       (loop for (,option ,value) on ,opts-not-empty by #'cddr
             do (case ,option ,@clauses)))))

(defun load-next-level ()
  (let ((level-number (mod *next-level* *num-levels*)))
    (setf *next-level* nil)
    (setf *level-number* level-number)
    (format t "LEVEL ~A~%" *level-number*)
    (setf *level* nil)
    (setf *level* (load-level *level-number*))))

(defun request-next-level ()
  (setf *next-level* (+ *level-number* 1)))

(defun request-restart-level ()
  (format t "RESTART~%")
  (setf *next-level* *level-number*))

(defun request-previous-level ()
  (setf *next-level* (- *level-number* 1)))

(defun main ()
  (let ((options (handler-case
                     (handler-bind ((opts:arg-parser-failed #'parser-error)
                                    (opts:unknown-option    #'unknown-option))
                       (opts:get-opts)))))
    (cond-option options
                 (:help (usage))
                 (:version (version))
                 (otherwise (run)))))