diff options
| -rw-r--r-- | basic.lsp | 2 | ||||
| -rw-r--r-- | cap-muck.lsp | 183 | ||||
| -rw-r--r-- | dbm.lsp | 27 | ||||
| -rw-r--r-- | doc/breaking_rules.md | 3 |
4 files changed, 213 insertions, 2 deletions
diff --git a/basic.lsp b/basic.lsp index 11771e9..135c2ba 100644 --- a/basic.lsp +++ b/basic.lsp @@ -1,4 +1,4 @@ -#!/Users/dbane/openlisp-11.0.0/uxlisp -shell +#!/home/dbane/openlisp-11.0.0/uxlisp -shell (require "abs-syn") (require "lex") diff --git a/cap-muck.lsp b/cap-muck.lsp new file mode 100644 index 0000000..fd90626 --- /dev/null +++ b/cap-muck.lsp @@ -0,0 +1,183 @@ +(defpackage #:cap-muck + (:use #:openlisp) + (:export + #:main) + ) +(in-package #:cap-muck) +(defglobal *terminate-program* nil) + +(defconstant +bold+ "#\esc[1m") +(defconstant +unbold+ "#\esc[0m") +(defconstant +q+ #\") + +(defclass <avatar> () ((name :accessor name) + (playing :reader playing :initform nil) + (password :accessor password))) +(defglobal *avatars* '()) + +(defglobal *write-avatars* nil) + +(defclass <connection> () ((g :reader g) + (socket :reader socket) + (parser :reader parser) + (avatar :reader avatar) + (curr-room :reader curr-room))) +(defglobal *connections* '()) + +(defconstant +port-number+ 6565) + +(defconstant +vd-type+ #(n s e w u d)) + +(defclass <room> () ((name :reader name) + (desc :reader desc) + (exits :reader exits))) +(defglobal *rooms* '()) + +(defglobal *write-rooms* nil) + +(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") + +(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 format-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 (curr-room c) r) + (say c s))))) + +(defun look (c) + (say c (concatenate 'string "Room: " (name (curr-room c)))) + (do ((ds (desc (curr-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 (curr-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. +;; +;; Or dbm? +(defun read-room-database () + (setq *rooms* '()) + (with-open-input-file (file +rdb+) + (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-output-file (file +rdb+) + (mapcar (lambda (r) (print-object r file)) *rooms*)) + (setq *write-rooms* nil)) + +(defun read-avatar-database () + (setq *avatars* '()) + (with-open-input-file (file +adb+) + (do ((name (read-line file nil nil)) + (password (read-line file nil nil))) + ((or (null name) (null password))) + (let ((a (make-instance (find-class '<avatar>)))) + (setf (name a) name) + (setf (password a) password) + (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-output-file (file +adb+) + (mapcar (lambda (a) (print-object a file)) *avatars*))) + +(defun main () + (read-avatar-database) + (read-room-database) + (while (not *terminate-program*) + (check-for-inputs))) +(provide "cap-muck") diff --git a/dbm.lsp b/dbm.lsp new file mode 100644 index 0000000..52a0a27 --- /dev/null +++ b/dbm.lsp @@ -0,0 +1,27 @@ +;; No package, this is for eisl + +(c-include "<ndbm.h>") + +(defclass <dbm> () (db :accessor db)) + +(defgeneric clearerr (self)) +(defmethod clearerr ((self <dbm>)) + (flet ((clearerr-h (db) + (c-lang "dbm_clearerr(DB);"))) + (clearerr-h (db self)))) + +(defgeneric close (self)) + +(defgeneric delete (self key)) + +(defgeneric open (self openflags)) +(defmethod open ((self <dbm>) file openflags) + (flet ((open-h (file openflags) + (c-lang "res = dbm_open(FILE, OPENFLAGS, MODE);"))) + (setf (db self) (open-h file openflags)))) + +(defgeneric create (self openflags modes)) +(defmethod create ((self <dbm>) file openflags modes) + (flet ((open-h (file openflags modes) + (c-lang "res = dbm_open(FILE, OPENFLAGS, MODE);"))) + (setf (db self) (open-h file openflags modes)))) diff --git a/doc/breaking_rules.md b/doc/breaking_rules.md index 200f3b8..db4f28c 100644 --- a/doc/breaking_rules.md +++ b/doc/breaking_rules.md @@ -92,7 +92,8 @@ If absolutely necessary you can choose some of the libraries mentioned in the "P Even though this is a prototype, attention should be paid to basic craftsmanship. * Divide the system into packages, using the subset of CL that is - supported by OpenLisp + supported by OpenLisp. + This can start from just "section headers" with lots of semicolons. * Write docstrings for at least each public fun, class and package. There are good guidelines in the Elisp manual, but for now one sentence will suffice. * Use `declare` |