Permalink
Browse files

Merge branch 'master' of github.com:flyingmachine/hobbitvgiant

  • Loading branch information...
flyingmachine committed May 2, 2012
2 parents ee90be7 + 82f3aa0 commit bb17d189f7eee0a647148b6fd86e29f0101284d4
Showing with 61 additions and 0 deletions.
  1. +2 −0 body-classes.lisp
  2. +59 −0 observer.lisp
View
@@ -104,6 +104,8 @@
(defmethod modify-damage ((body-part body-part) damage-type modification)
(incf (damage-for (damage-received body-part) damage-type) modification))
+(defgeneric defproxy (proxy-name proxied-name method-name))
+
(defmacro defproxy (proxy-name proxied-name method-name)
`(defmethod ,method-name ((,proxy-name ,proxy-name))
(,method-name (,proxied-name ,proxy-name))))
View
@@ -0,0 +1,59 @@
+(defclass observable ()
+ ((observers
+ :initform (make-hash-table)
+ :accessor observers)))
+
+(defclass player (observable)
+ ((health
+ :initarg :health
+ :initform 100
+ :accessor health)
+
+ (ap
+ :initarg :ap
+ :initform 20
+ :accessor ap)))
+
+(defclass game-room (observable)
+ ((description
+ :initarg :description
+ :initform "It's a room"
+ :accessor description)
+
+ (events
+ :initarg :events
+ :accessor events)))
+
+(defmacro observable-slots (classname &rest slotnames)
+ `(progn
+ ,@(mapcar (lambda (slotname)
+ `(defmethod (setf ,slotname) :after (val (instance ,classname))
+ (mapc (lambda (observer)
+ (funcall observer val))
+ (gethash ',slotname (observers instance)))))
+ slotnames)))
+
+(defmethod add-observer ((observed observable) slotname fn)
+ (setf (gethash slotname (observers observed))
+ (nconc (gethash slotname (observers observed)) (list fn))))
+
+
+(defun room-subscribe-to-player (room player)
+ (mapc (lambda (slotname)
+ (add-observer player
+ slotname
+ (lambda (val)
+ (setf (events room) (list slotname val)))))
+ '(health ap)))
+
+(observable-slots player health ap)
+(observable-slots game-room events)
+
+(setf p1 (make-instance 'player))
+(setf p2 (make-instance 'player))
+
+(setf r1 (make-instance 'game-room))
+(setf r2 (make-instance 'game-room))
+
+(room-subscribe-to-player r1 p1)
+(room-subscribe-to-player r1 p2)

0 comments on commit bb17d18

Please sign in to comment.