diff options
Diffstat (limited to 'ccap-muck.lisp')
| -rw-r--r-- | ccap-muck.lisp | 149 |
1 files changed, 130 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") |