From ab10720260e2c184b319026da89f4dfd338500bb Mon Sep 17 00:00:00 2001
From: Brian Cully <bjc@kublai.com>
Date: Wed, 2 Apr 2008 19:20:20 -0400
Subject: Initial commit

---
 Lisp/moxie/world.lisp | 120 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 120 insertions(+)
 create mode 100644 Lisp/moxie/world.lisp

(limited to 'Lisp/moxie/world.lisp')

diff --git a/Lisp/moxie/world.lisp b/Lisp/moxie/world.lisp
new file mode 100644
index 0000000..af6ee65
--- /dev/null
+++ b/Lisp/moxie/world.lisp
@@ -0,0 +1,120 @@
+;;; -*- Lisp -*-
+;; $Id: world.lisp 48 2006-01-09 00:27:16Z bjc $
+(in-package :moxie)
+
+(defvar *worlds* (make-hash-table)
+  "The world environments, keyed on world id.")
+
+(let ((next-world-id 0))
+  (defclass world ()
+    ((id :initarg :id :initform (incf next-world-id)
+         :accessor world-id
+         :documentation "The world id.")
+     (vars :initarg :vars :initform nil
+           :accessor world-vars
+           :documentation "Savable settings.")
+     (save-path :initarg :save-path :initform nil
+                :accessor world-save-path
+                :documentation "File path.")
+     (stream :initarg :stream :initform nil
+             :accessor world-stream
+             :documentation "Connection to server.")
+     (connected :initarg :connected :initform nil
+                :accessor world-connected
+                :documentation "Are we currently connected?"))
+    (:documentation "All associated world information.")))
+
+(defgeneric load-world-state (world &key path &allow-other-keys)
+  (:documentation "Returns an ALIST from WORLD's disk location, or PATH (if set)."))
+
+(defgeneric save-world-state (world &key path as-copy &allow-other-keys)
+  (:documentation "Saves WORLD's state to its disk location or PATH (if set)."))
+
+(defgeneric world-event-handler (event &rest args)
+  (:documentation "Handle EVENT (w/ ARGS) for *WORLD*."))
+
+(defmethod initialize-instance ((instance world) &rest initargs)
+  (declare (ignore initargs))
+  (format t "initialize-instance world~%")
+  (add-world (call-next-method)))
+
+(defmethod world-event-handler (event &rest args)
+  "Default handler doesn't know about anything, so it logs, instead."
+  (format t "Don't know how to handle event ~S ~S from world ~S.~%"
+          event args (world-id *world*)))
+
+(defun add-world (world)
+  (setf (gethash (world-id world) *worlds*) world))
+
+(defun remove-world (world)
+  (remhash (world-id world) *worlds*))
+
+(defun map-worlds (fn)
+  (let ((result nil))
+    (maphash (lambda (k v)
+               (declare (ignore k))
+               (setf result (cons (funcall fn v) result)))
+             *worlds*)
+    (nreverse result)))
+
+(defun map-world-vars (fn &optional (world *world*))
+  (mapcar (lambda (list)
+            (funcall fn (car list) (cdr list)))
+          (world-vars world)))
+
+(defun world-var (name &optional (world *world*))
+  "Returns the value for NAME in WORLD's environment."
+  (cdr (assoc name (world-vars world))))
+
+(defun set-world-var (name value &optional (world *world*))
+  "Sets the value of NAME to VALUE in WORLD's environment."
+  (setf (world-vars world)
+        (cons (cons name value)
+              (remove-if (lambda (x)
+                           (eql (car x) name))
+                         (world-vars world)))))
+
+(defsetf world-var (name &optional (world '*world*)) (value)
+  `(set-world-var ,name ,value ,world))
+
+(defun close-world (&optional (world *world*))
+  "Closes WORLD."
+  (world-disconnect world)
+  (remove-world world)
+  (let ((*world* world))
+    (run-hook :world-closed-hook)))
+
+(defun world-connect (&optional (world *world*))
+  "Connects WORLD to the host and port specified."
+  (awhen (aand (world-var :hostname world) (world-var :port world)
+               (open-connection (world-var :hostname world) (world-var :port world)))
+    (add-input-handler it
+                       (lambda (stream)
+                         (let ((*world* world))
+                           (handler-case
+                               (while (listen stream)
+                                 (multiple-value-bind (line missing-newline-p) (read-line stream)
+                                   (run-hook :output-from-server-hook line)
+                                   (when missing-newline-p
+                                     (signal 'end-of-file))))
+                             (end-of-file ()
+                               (world-disconnect world))))))
+    (setf (world-stream world) it)
+    (setf (world-connected world) t)
+    (let ((*world* world))
+      (run-hook :world-connected-hook))))
+
+(defun world-disconnect (&optional (world *world*))
+  "Closes the connection, if opened, for WORLD."
+  (let ((*world* world))
+    (when (world-connected *world*)
+      (close-connection (world-stream *world*))
+      (setf (world-stream *world*) nil)
+      (setf (world-connected *world*) nil)
+      (run-hook :world-disconnected-hook))))
+
+(defun world-event (world-id &rest args)
+  (format t "DEBUG: world-event ~S ~S~%" world-id args)
+  (let ((*world* (or (gethash world-id *worlds*)
+                     (make-instance 'world :id world-id))))
+    (apply #'world-event-handler args)))
\ No newline at end of file
-- 
cgit v1.2.3