Permalink
Browse files

add doors that can be opened and closed

  • Loading branch information...
1 parent 9bc7ef3 commit 41aeeb33aa08c3c7835ea3eaf2102c505083ec99 @StrmSrfr StrmSrfr committed Jan 7, 2012
Showing with 112 additions and 3 deletions.
  1. +63 −1 action.lisp
  2. +30 −0 door.lisp
  3. +6 −0 icon.lisp
  4. +2 −0 mum.asd
  5. +3 −1 mum.lisp
  6. +6 −0 openable.lisp
  7. +2 −1 package.lisp
View
64 action.lisp
@@ -21,7 +21,7 @@ representing an unrecognized action.")
(format stream "~S ~S" (verb action) (arguments action))))
(defparameter *action-verbs*
- '(:attack :build :talk :move :stay :proxiport)
+ '(:attack :build :close :open :talk :move :stay :proxiport)
"All recognized action verbs.")
(defun quasi-intern (string-designator symbol-list)
@@ -77,6 +77,16 @@ representing an unrecognized action.")
(mapcar #'car
*directions*)))
+(defmethod action-prompt-3 (player (verb (eql :open)) arguments)
+ (prompt-player player "Which direction?"
+ (mapcar #'car
+ *directions*)))
+
+(defmethod action-prompt-3 (player (verb (eql :close)) arguments)
+ (prompt-player player "Which direction?"
+ (mapcar #'car
+ *directions*)))
+
(defmethod action-fully-specified-p-2 ((verb (eql :attack)) (arguments list))
"One argument: the direction. Must be in *DIRECTIONS*."
(and
@@ -86,6 +96,24 @@ representing an unrecognized action.")
(assoc dir
*directions*))))
+(defmethod action-fully-specified-p-2 ((verb (eql :open)) (arguments list))
+ "One argument: the direction. Must be in *DIRECTIONS*."
+ (and
+ (= (length arguments) 1)
+ (let ((dir (quasi-intern (first arguments)
+ (mapcar #'car *directions*))))
+ (assoc dir
+ *directions*))))
+
+(defmethod action-fully-specified-p-2 ((verb (eql :close)) (arguments list))
+ "One argument: the direction. Must be in *DIRECTIONS*."
+ (and
+ (= (length arguments) 1)
+ (let ((dir (quasi-intern (first arguments)
+ (mapcar #'car *directions*))))
+ (assoc dir
+ *directions*))))
+
(defmethod action-fully-specified-p-2 ((verb (eql :build)) (arguments list))
"One argument: the direction. Must be in *DIRECTIONS*."
(and
@@ -132,6 +160,40 @@ representing an unrecognized action.")
(weapon (first (weapons player))))
(deal-damage player target weapon (roll (damage weapon)))))
+(defmethod perform-action-5 (world player turn (verb (eql :open)) (arguments list))
+ (let*((direction (quasi-intern (first arguments)
+ (mapcar #'car *directions*)))
+ (location (mapcar #'+
+ (coordinates player)
+ (cdr (assoc direction *directions*))))
+ (target (find location (walls (arena turn)) :key 'coordinates :test #'equal)))
+ (cond
+ ((null target)
+ (message-player player turn "You try to open the darkness, but in vain."))
+ ((not (typep target 'openable))
+ (message-player player turn
+ (format nil "You try to open ~A, but in vain."
+ (name target))))
+ (t
+ (open target)))))
+
+(defmethod perform-action-5 (world player turn (verb (eql :close)) (arguments list))
+ (let*((direction (quasi-intern (first arguments)
+ (mapcar #'car *directions*)))
+ (location (mapcar #'+
+ (coordinates player)
+ (cdr (assoc direction *directions*))))
+ (target (find location (walls (arena turn)) :key 'coordinates :test #'equal)))
+ (cond
+ ((null target)
+ (message-player player turn "You try to close the darkness, but in vain."))
+ ((not (typep target 'openable))
+ (message-player player turn
+ (format nil "You try to close ~A, but in vain."
+ (name target))))
+ (t
+ (close target)))))
+
(defmethod perform-action-5 (world player turn (verb (eql :build)) (arguments list))
(let*((direction (quasi-intern (first arguments)
(mapcar #'car *directions*)))
View
30 door.lisp
@@ -0,0 +1,30 @@
+;;;; door.lisp
+
+(in-package #:mum)
+
+(defclass door (openable)
+ ((name; inherited from icon-mixin
+ :initform "a closed door")
+ (icon; inherited from icon-mixin
+ :initform +closed-door-icon+)
+ (open-p
+ :accessor open-p
+ :initarg :open-p
+ :initform nil
+ :type boolean)))
+
+(defmethod open ((door door))
+ (setf (name door) "an open door"
+ (open-p door) t
+ (icon door) +open-door-icon+))
+
+(defmethod close ((door door))
+ (setf (name door) "a closed door"
+ (open-p door) nil
+ (icon door) +closed-door-icon+))
+
+(defmethod collide-p ((object position-mixin) (door door) (direction symbol) (turn turn))
+ (and (call-next-method)
+ (not (open-p door))))
+
+
View
6 icon.lisp
@@ -15,6 +15,12 @@
:accessor tooltip
:initarg :tooltip)))
+(defparameter +closed-door-icon+
+ (make-instance 'icon :glyph "+" :tooltip "a closed door"))
+
+(defparameter +open-door-icon+
+ (make-instance 'icon :glyph "'" :tooltip "an open door"))
+
(defparameter +player-icon+
(make-instance 'icon :glyph "p" :tooltip "somebody"))
View
2 mum.asd
@@ -20,8 +20,10 @@
(:file "collision" :depends-on ("package"))
(:file "damage-mixin" :depends-on ("package"))
(:file "dice" :depends-on ("package"))
+ (:file "door" :depends-on ("package" "openable"))
(:file "icon" :depends-on ("package"))
(:file "icon-mixin" :depends-on ("package" "icon" "position-mixin"))
+ (:file "openable" :depends-on ("icon-mixin"))
(:file "position-mixin" :depends-on ("package"))
(:file "turn" :depends-on ("package" "generics" "player"))
(:file "player" :depends-on ("package" "damage-mixin" "icon-mixin"))
View
4 mum.lisp
@@ -309,7 +309,9 @@ which initiated this update."
(:form :id "spellbox" :style "float: left"
(:input :type "button" :id "proxiport" :value "proxiport" :class "action")
(:input :type "button" :id "attack" :value "attack" :class "action")
- (:input :type "button" :id "build" :value "build" :class "action")))
+ (:input :type "button" :id "build" :value "build" :class "action")
+ (:input :type "button" :id "open" :value "open" :class "action")
+ (:input :type "button" :id "close" :value "close" :class "action")))
(:script :type "text/javascript"; TOOD: move this to a proper test suite
(cl-who:str
(parenscript:ps
View
6 openable.lisp
@@ -0,0 +1,6 @@
+;;;; openable.lisp
+
+(in-package #:mum)
+
+(defclass openable (icon-mixin)
+ ())
View
3 package.lisp
@@ -1,5 +1,6 @@
;;;; package.lisp
(defpackage #:mum
- (:use #:cl))
+ (:use #:cl #:parenscript)
+ (:shadow close open))

0 comments on commit 41aeeb3

Please sign in to comment.