--- a/package.lisp Tue Aug 02 14:31:39 2016 +0000
+++ b/package.lisp Thu Aug 04 12:57:14 2016 +0000
@@ -46,5 +46,4 @@
#:iterate
#:cl-arrows
#:silt.quickutils
- #:silt.utils
- #:state-machine))
+ #:silt.utils))
--- a/silt.asd Tue Aug 02 14:31:39 2016 +0000
+++ b/silt.asd Thu Aug 04 12:57:14 2016 +0000
@@ -15,8 +15,7 @@
:components
((:module "vendor"
:serial t
- :components ((:file "quickutils")
- (:file "state-machine")))
+ :components ((:file "quickutils")))
(:file "package")
(:module "src"
:serial t
--- a/src/main.lisp Tue Aug 02 14:31:39 2016 +0000
+++ b/src/main.lisp Thu Aug 04 12:57:14 2016 +0000
@@ -27,14 +27,8 @@
(defun clamp-h (y)
(clamp 0 (1- *height*) y))
-(defun write-centered (string x y)
- (charms:write-string-at-point
- charms:*standard-window*
- string
- (clamp-w (- x (floor (length string) 2)))
- (clamp-h y)))
-(defun write-left (string x y)
+(defun write-string-at (string x y)
(charms:write-string-at-point
charms:*standard-window*
string
@@ -42,20 +36,40 @@
(clamp-h y)))
+(defun write-centered (text x y)
+ (etypecase text
+ (string (write-centered (list text) x y))
+ (list (iterate
+ (for string :in text)
+ (for tx = (- x (floor (length string) 2)))
+ (for ty :from y)
+ (write-string-at string tx ty)))))
+
+(defun write-left (text x y)
+ (etypecase text
+ (string (write-left (list text) x y))
+ (list (iterate
+ (for string :in text)
+ (for tx = x)
+ (for ty :from y)
+ (write-string-at string tx ty)))))
+
+
(defun render-title ()
(render
(let ((cx (floor *width* 2))
(cy (floor *height* 2)))
- (write-centered "S I L T" cx cy)
- (write-centered "Press any key to start..." cx (1+ cy)) )))
+ (write-centered '("S I L T"
+ ""
+ "Press any key to start...")
+ cx (1- cy)))))
(defun render-intro ()
(render
- (charms:move-cursor charms:*standard-window*
- (- (floor *width* 2) 3)
- (floor *height* 2))
- (write-left "Welcome to Silt." 0 0)
- (write-left "You are the god of a toroidal world." 0 1)))
+ (write-left '("Welcome to Silt."
+ ""
+ "You are the god of a toroidal world.")
+ 0 0)))
(defun handle-input-title ()
@@ -67,19 +81,18 @@
(charms:get-char charms:*standard-window*))
-(defparameter *game*
- (state-machine ()
- ((title ()
- (render-title)
- (handle-input-title)
- (transition intro))
- (intro ()
- (render-intro)
- (handle-input-intro)
- (transition quit))
- (quit ()
- 'goodbye))
- (transition title)))
+(defun state-title ()
+ (render-title)
+ (handle-input-title)
+ (state-intro))
+
+(defun state-intro ()
+ (render-intro)
+ (handle-input-intro)
+ (state-quit))
+
+(defun state-quit ()
+ 'goodbye)
(defun run ()
@@ -88,6 +101,6 @@
(charms:disable-echoing)
(charms:enable-raw-input :interpret-control-characters t)
; (charms:enable-non-blocking-mode charms:*standard-window*)
- (invoke-state-machine *game*)))
+ (state-title)))
; (run)
--- a/vendor/state-machine.lisp Tue Aug 02 14:31:39 2016 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,139 +0,0 @@
-;;;; https://bitbucket.org/tarballs_are_good/lisp-random/src/a57dc2cd93ee6aa689d9b68f3f6eb62f7dd67cd2/state-machine.lisp
-(defpackage #:state-machine
- (:use #:cl)
- (:export
- #:state-machine
- #:invoke-state-machine
- #:transition))
-
-(in-package #:state-machine)
-
-;;;; state-machine.lisp
-;;;;
-;;;; Copyright (c) 2015 Robert Smith
-;;;;
-;;;; This file is an attempt to build a relatively efficient state
-;;;; machine abstraction.
-
-;;;; Bugs: SBCL complains about modifying constant data. I don't know if it is right or if I am right.
-
-;;; (ql:quickload :alexandria)
-
-(defclass state-machine ()
- ((states :initarg :states
- :reader state-machine-states
- :documentation "A list of the names of each state.")
- (transition-graph :initarg :transition-graph
- :reader state-machine-transition-graph
- :documentation "A hash table containing the state names as keys and a list of possible transitions as values.")
- (invocation-function :initarg :invocation-function
- :reader state-machine-invocation-function
- :documentation "The multivariate function to invoke to enter the state machine.")))
-
-(defgeneric invoke-state-machine (sm &rest args)
- (:method ((sm state-machine) &rest args)
- (apply (state-machine-invocation-function sm) args)))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-(defun contains-duplicates-p (list &key (test 'eql))
- (/= (list-length list)
- (list-length (remove-duplicates list :test test))))
-)
-
-(defmacro transition (state &rest args)
- (declare (ignore state args))
- (error "Transition is an internal macro to DEFINE-STATE-MACHINE."))
-
-(defmacro state-machine (args state-definitions &body body)
- "Create a state machine which takes the arguments ARGS the body BODY. Return a state machine object which can be invoked with the arguments ARGS.
-
-STATE-DEFINITIONS is a list of state definitions. It looks much like the definition of a LABELS function definition:
-
- (state-name arguments
- [documentation]
- [declarations]
- forms ...)
-
-Within the state definitions, however, there is a macro defined called TRANSITION which transitions to one of the other states immediately without return. (The use of TRANSITION ensures that a tail call will happen.)
-
-BODY can enter the state machine
-
-\(It is allowed, but discouraged, to bypass the use of TRANSITION by simply calling the state name as a function instead.)"
- (let ((states (mapcar #'first state-definitions))
- (transition-graph (make-hash-table)))
- (labels ((construct-state (state-def)
- (destructuring-bind (name args . body) state-def
- (multiple-value-bind (forms decls doc)
- (silt.quickutils:parse-body body :documentation t)
- ;; This is a LABELS function definition.
- `(,name ,args
- ,@(and doc (list doc))
- ,@decls
- (macrolet ((transition (state &rest args)
- (unless (member state ',states)
- (error "The state ~S in the transition ~
- occurring in the state ~S ~
- is not a valid."
- state
- ',name))
- (pushnew state
- (gethash ',name ,transition-graph))
- `(return-from ,',name
- (,state ,@args))))
- ,@forms))))))
- (when (contains-duplicates-p states)
- (warn "There are duplicate state names in the state machine."))
- (multiple-value-bind (forms decls doc)
- (silt.quickutils:parse-body body :documentation t)
- `(make-instance
- 'state-machine
- :states ',(remove-duplicates states)
- :transition-graph ',transition-graph
- :invocation-function
- (lambda ,args
- ,@(and doc (list doc))
- ,@decls
- (labels ,(mapcar #'construct-state state-definitions)
- (macrolet ((transition (state &rest args)
- (unless (member state ',states)
- (error "The state ~S in the initial transition ~
- is not a valid."
- state))
- (pushnew state
- (gethash nil ,transition-graph))
- `(,state ,@args)))
- ,@forms))))))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Examples ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defparameter *beer-machine*
- (state-machine (count)
- ((decide (current-count)
- (if (= 1 current-count)
- (transition last-case)
- (transition general-case current-count)))
- (general-case (current-count)
- (format t "~D bottles of beer on the wall, ~D bottles of beer.~%~
- Take one down, pass it around, ~D bottle~:P of beer on ~
- the wall...~%"
- current-count
- current-count
- (1- current-count))
- (transition decide (1- current-count)))
- (last-case ()
- (format t "If that one bottle should happen to fall, what a waste ~
- of alcohol!")))
- (transition decide count)))
-
-(defparameter *tail-call-test*
- (state-machine (x)
- ((even (x)
- (if (zerop x)
- t
- (transition odd (1- x))))
- (odd (x)
- (if (zerop x)
- nil
- (transition even (1- x)))))
- (even x)))