Checkpointing MUD dev

2 files changed, 135 insertions, 19 deletions

diff --git a/ccap-muck.lisp b/ccap-muck.lisp
index d9de3b0..9931b63 100644
--- a/ccap-muck.lisp
+++ b/ccap-muck.lisp
@@ -1,7 +1,15 @@
+(require "split-sequence")
+(defpackage #:ccap-muck
+  (:use #:common-lisp #:split-sequence)
+  (:export
+   #:main)
+  )
+(in-package #:ccap-muck)
+
 (defvar *terminate-program* nil)
 
-(defconstant +bold+ "[1m")
-(defconstant +unbold+ "[0m")
+(defconstant +bold+ "#\esc[1m")
+(defconstant +unbold+ "#\esc[0m")
 (defconstant +q+ #\")
 
 (defclass <avatar> () ((name :accessor name)
@@ -15,13 +23,12 @@
                            (socket :reader socket)
                            (parser :reader parser)
                            (avatar :reader avatar)
-                           (r :reader r)))
+                           (room :reader room)))
 (defvar *connections* '())
 
 (defconstant +port-number+ 6565)
 
-(defconstant +vd-type+ (vector 'n 's 'e 'w
-			       'u 'd))
+(defconstant +vd-type+ #(n s e w u d))
 
 (defclass <room> () ((name :reader name)
 		     (desc :reader desc)
@@ -30,25 +37,124 @@
 
 (defvar *write-rooms* nil)
 
-(defconstant +command-type+ (vector 'say 'help 'quit 'look
-				    'rooms 'make-room 'make-door 'teleport
-				    'n 's 'e 'w
-				    'u 'd 'password 'shutdown))
+(defconstant +command-type+ #(say help quit look
+			      rooms make-room make-door teleport
+			      n s e w
+			      u d password shutdown))
 
 (defconstant +name-prompt+ "Please enter your character name:")
 
 (defconstant +rdb+ "room.tam")
 (defconstant +adb+ "avatar.tam")
 
-;; TODO: should I use print-object & the reader for serialisation?
+(defun first-substr (s)
+  "Return the first substring of s (delimited by a space)."
+  (block result-first-substr
+    (do ((i 0 (+ i 1)))
+        ((>= i (length s)) s)
+      (if (char= (elt s i) #\space)
+          (return-from result-first-substr (subseq s 0 i))))))
+
+(defun rest-substr (s)
+  "Return the second part of s."
+  (block result-rest-substr
+    (let ((b nil))
+      (do ((i 0 (+ i 1)))
+          ((>= i (length s)) "")
+        (if (char= (elt s i) #\space)
+            (setq b t)
+            (if b
+                (return-from result-rest-substr (subseq s i (length s)))))))))
+
+(defun command (s)
+  (block result-command
+    (do ((i 0 (+ i 1)))
+        ((>= i (length +command-type+)) 'say)
+      (let ((c (elt +command-type+ i)))
+        (if (string= s (symbol-name c))
+            (return-from result-command c))))))
+
+(defun name (c)
+  (concatenate 'string +bold+ (name (avatar c)) +unbold))
+
+(defun say (c s)
+  (if (g c)
+      (format (socket c) "~A~%" s)))
+
+(defun broadcast (s)
+  (do ((cs *connections* (cdr cs)))
+      ((null cs))
+    (let ((c (car cs)))
+      (say c s))))
+
+(defun say (r s)
+  (do ((cs *connections* (cdr cs)))
+      ((null cs))
+    (let ((c (car cs)))
+      (if (eq (room c) r)
+          (say c s)))))
+
+(defun look (c)
+  (say c (concatenate 'string "Room: " (name (room c))))
+  (do ((ds (desc (room c)) (cdr ds)))
+      ((null ds))
+    (let ((d (car ds)))
+      (say c (line d))))
+  (say c "")
+  (say c "Exits:")
+  (do ((i 0 (+ i 1)))
+      ((>= i (length +vd-type+)))
+    (let ((e (elt (exits (room c)) i)))
+      (if (not (null e))
+          (say c (concatenate 'string " " (symbol-name (elt +vd-type+ i)) " " (name e))))))
+  (say c "Avatars:")
+  ()
+
+;; TODO: Use the reader, for prototype at least?
+;;       Can switch to postmodern for production.
 (defun read-room-database ()
+  (setq *rooms* '())
   (with-open-file (file +rdb+ :direction :input)
-    ))
+    (flet ((read-desc ()
+             (let ((ls '()))
+               (do ((l (read-line file) (read-line file)))
+                   ((string= l ".") ls)
+                 (setq ls (cons l ls)))))
+           (skip-lines (n)
+             (do ((i 0 (+ i 1)))
+                 ((> i n))
+               (read-line file))))
+      (do ((name (read-line file nil nil))
+           (desc (read-desc)))
+          ((or (null name) (null desc)))
+        (skip-lines (length +vd-type+))
+        (let ((r (make-instance (find-class '<room>))))
+          (setf (name r) name)
+          (setf (desc r) desc)
+          (setq *rooms* (cons r *rooms*))))
+      (file-position file 0)
+      (
+
+(defmethod print-object ((obj <room>) stream)
+  (flet ((write-desc (ds)
+           (mapcar (lambda (l)
+                     (format stream "~A~%" l))
+                   ds))
+         (write-exits (es)
+           (do ((i 0 (+ i 1)))
+               ((> i (length +vd-type+)))
+             (if (null (elt es) i)
+                 (format stream "nil~%")
+                 (format stream "~A~%" (name (elt es i)))))))
+    (format stream "~A~%" (name r))
+    (write-desc (desc r))
+    (format stream ".~%")
+    (write-exits (exits r))))
 
 (defun write-room-database ()
   (with-open-file (file +rdb+ :direction output)
-    (mapcar (lambda (r)
-	      (format file "~A~%"
+    (mapcar (lambda (r) (print-object r file)) *rooms*)) 
+  (setq *write-rooms* nil))
 
 (defun read-avatar-database ()
   (setq *avatars* '())
@@ -62,11 +168,16 @@
 	(setq *avatars* (cons a *avatars*)))))
   (setq *write-avatars* nil))
 
+(defmethod print-object ((obj <avatar>) stream)
+  (format stream "~A~%~A~%" (name a) (password a)))
+
 (defun write-avatar-database ()
   (with-open-file (file +adb+ :direction output)
-    (mapcar (lambda (a) (format file "~A~%~A~%" (name a) (password a))) *avatars*)))
-
-(read-avatar-database)
-(read-room-database)
-(while (not *terminate-program*)
-       (check-for-inputs))
+    (mapcar (lambda (a) (print-object a file)) *avatars*)))
+
+(defun main ()
+  (read-avatar-database)
+  (read-room-database)
+  (while (not *terminate-program*)
+	 (check-for-inputs)))
+(provide "ccap-muck")
diff --git a/doc/breaking_rules.md b/doc/breaking_rules.md
index 0c34594..61eb2d4 100644
--- a/doc/breaking_rules.md
+++ b/doc/breaking_rules.md
@@ -76,6 +76,11 @@ Detailed implementations, libraries, etc. are as follows:
 * For simple multi-user,
   use IRCv3, including the bots (nickserv, chanserv), and tilde.chat.
 
+For a very mathematical domain,
+APL might be a better choice.
+However, if more than the mathematical features are required
+it could be difficult to satisfy expectations.
+
 ### Dependencies
 
 For the prototyping phase,