#| ./main.lisp => the room named |Living Room| is empty go ROOM => |Living Room| => EMPTY => :COMMITTING :DONE => |Living Room| A ROOM named |Living Room|. T => *it* |Living Room| T => the cat named |Sally| is grey go CAT => |Sally| => GREY => :COMMITTING :DONE => *it* |Sally| T => |Sally| A CAT named |Sally|. T => put |Sally| in the room go OR put |Sally| in the |Living Room| go |# (defpackage :main (:use :cl) (:shadow :ROOM) (:export "MAIN")) (in-package :main) (defvar *things* ()) (defvar *rooms* ()) (defvar *keys* ()) (defvar *computers* ()) (defconstant *user-id* 0) (defclass Thing () ( (name :accessor name :initarg :name) (value :accessor value :initarg :value) (who :accessor who :initform *user-id*) (what :accessor what :initarg :what) (where :accessor where :initarg :where) ;(when :accessor when :initform (get-universal-time)) (why :accessor why :initarg :why) #| who - created or last modified the object what - is the object where - ? when - what time was the object created at why - was the object created |# (description :accessor description :initarg :description) (parameters :accessor parameters :initarg :contents :initform ()) (on :accessor on :initarg :on :initform () ) (under :accessor under :initarg :under :initform ()) (inside :accessor inside :initarg :inside :initform ()) (ingredients :accessor ingredients :initarg :ingredients :initform ()) ) ) (defmethod print-object ((thing Thing) s) (print (name thing)) s) ;(defmethod print-object ((thing Thing) s) ; (format s "A ~S named ~S.~%~%" (what thing) (name thing)) ; (format s "It is ~A." (description thing))) #| (defmethod print-object ((object Thing) stream) (format stream "~S: ~S" (name object) (what object)) (when (description object) (format stream "~A~%" (description object))) (when (on object) (format stream "On: ~S~%" (on object))) (when (under object) (format stream "Under: ~S~%" (under object))) (when (inside object) (format stream "Inside: ~S~%" (ingredients object))) (when (parameters object) (format stream "Parameters: ~S~%" (parameters object))) (when (ingredients object) (format stream "Ingredients: ~S~%" (inside object))) ) |# (defclass Room (Thing) ((exits :accessor Room-exits :initarg :exits :initform ())) ) ;;(defmethod print-object ((object Room) stream) ;; (format stream "~S~%" (Room-exits object))) (defmethod put-in ((object Room) (inside Thing)) (push inside (inside object))) (defmethod put-on ((surface Thing) (object Thing)) (push object (on surface))) (defmethod put-under ((surface Thing) (object Thing)) (push object (under surface))) (defmethod make-of ((surface Thing) (object Thing)) (push object (ingredients surface))) (defmethod connect ((from Room) (to Room) &key locked) (pushnew to (Room-exits from))) (defun make-room (name description &rest exits) (make-instance 'Room :name name :description description :exits exits)) (defun make-thing (name description ingredients) (make-instance 'Thing :name name :description description :ingredients ingredients)) (defmacro defroom (name description &rest exits) `(progn (defvar ,name (make-room ',name ',description ,@exits)) (push ,name *rooms*) ,name) ) (defmacro defthing (name description &rest ingredients) `(progn (defvar ,name (make-thing ,(symbol-name name) ',description ',(let (retvals) (dolist (ingredient ingredients retvals) (push (eval `(defvar ,(intern (format nil "~A/~A" name (first ingredient))) ,(second ingredient))) retvals))))) (push ,name *things*) ,name) ) (defmacro defkey (name description) `(progn (defthing ,name ,description) (push ,name *keys*) ,name) ) (defroom |Living Room| "The Living Room.") (defroom |Office| "The Office.") (connect |Living Room| |Office|) (defroom |Kitchen| "The Kitchen.") (connect |Living Room| |Kitchen|) (defroom |Bedroom| "The Bedroom.") (connect |Living Room| |Bedroom|) (defroom |Bathroom| "The Bathroom.") (defroom |Entrance| "The foyer.") (connect |Living Room| |Entrance|) (connect |Entrance| |Bathroom|) (defroom |Hallway| "The hallway.") (connect |Entrance| |Hallway|) (defroom |Elevator| "The elevator that goes to my floor in my building.") (defroom |Main Lobby| "The Main Lobby to my condominium complex.") (connect |Living Room| |Office|) (connect |Living Room| |Bedroom|) (connect |Living Room| |Kitchen|) (connect |Kitchen| |Entrance|) (connect |Entrance| |Bathroom|) (connect |Entrance| |Hallway|) (defthing |Piano| "A Casio piano with weighted keys." (|Keys| "The keys of the piano, both black and white.") (|Pedal| "The sustain pedal of the paino.") (|Power Cord| "The power cord of the piano.") (|Music Stand| "A place to put Learning To Play The Piano books.")) (defthing |The Sphere of Silence| "A handy tool for meetings." (|Sphere| "The marble sphere of the Sphere of Silence.") (|Stand| "The triangular wire stand that the Sphere of Silence sits on.")) (defthing |A Statue of Money| "A heavy statue made of 2 pieces of art." (|12 Sided Piggy Bank| "A die shaped piggy bank filled with Pennies. $(.01xN). Metallic shiney finish. May be painted in the future due to old finish being worn.") (|Bottom of Red Pyramd| "The bottom layer of a Pyramid structure. Hollow and macde of Wood. Finished in Red tiles with shihing finish.")) (defthing |Change| "A collection of Toonies $2.00 (Dubloonies), Loonies $1.00, Quarters $0.25, Dimes $0.10, and Nickels $0.05.") (defthing |Pennies| "A collection of Pennies $0.01.") (defthing |The Mona Lisa X Frame| "Something that will soon contain Mona Lisa X.") (defthing |The Mona Lisa X (Unfinished)| "Parts of the Mona Lisa X.") (put-on |Piano| |The Sphere of Silence|) (put-on |Piano| |The Mona Lisa X Frame|) (put-in |Living Room| |Piano|) (put-in |Living Room| |Veriton|) (defthing |The Void| "Where everything eminates from. Libre Chaos.") (put-in |Living Room| |The Void|) (defmethod what-is-on-it? ((object Thing)) (format t "SURFACE: ~S~%" (name object)) (dolist (thing (on object)) (princ thing) (fresh-line))) (defmethod what-is-under-it? ((object Thing)) (dolist (thing (under object)) (princ thing) (fresh-line))) (defmethod what-is-in-it? ((object Thing)) (dolist (thing (inside object)) (princ thing) (fresh-line))) (defmethod what-is-it-made-of? ((object Thing)) (dolist (thing (ingredients object)) (princ thing) (fresh-line))) ;(print |Veriton|) ;(what-is-on-it? |Piano|) (defun command-ingredients (args) (let ((symbol (second args))) (format t "INGREDIENTS: ~S~%" symbol) (what-is-it-made-of? (eval symbol)) (fresh-line))) (defun command-objects (args) (declare (ignore args)) (format t "OBJECTS~%~%") (dolist (thing *things*) (format t "~S: ~S~%" (name thing) (description thing)))) (defvar *home* |Living Room|) (defvar *position* *home*) (defun command-exits (args) (when (Room-exits *position*) (format t "EXITS~%~%~{~A~^, ~}" (Room-exits *position*)))) (defun command-look (args) (let ((location (or (second args) *position*))) (format t "LOOK~%~%~A~%~%" (description location)) (dolist (thing (inside location)) (print thing)))) (defun command-go (args) (setf *position* (eval (or (second args) *home*))) (print *position*)) (defun mud () (catch :quit (fresh-line) (loop (let* ((line (progn (format t "|~A| $ " (name *position*)) (read-line))) (expr (read-from-string (concatenate :string "(" line ")")))) (case (and (listp expr) (first expr)) (go (command-go expr)) (ingredients (command-ingredients expr)) (objects (command-objects expr)) (exits (command-exits expr)) (things (command-things expr)) (look (command-look expr)) (quit (throw :quit nil)) (t (print (evaluate-symbol expr)))))))) (defvar *registers* (make-hash-table)) (defvar *it* |The Void|) (defvar *what* nil) (defvar *name* nil) (defun read-a/an (word) ;; a/an *what* (setf *what* word)) (defun read-a (word) (read-a/an word)) (defun read-an (word) (read-a/an word)) (defun read-the () (let* ((what (safe-read)) (thing (evaluate-symbol what))) (setf *what* thing (gethash thing *registers*) thing))) (defun read-in () (let ((what (read-the)) (in? (safe-read))) (unless (eq in? :in) (error "Expecting in.")) (let ((where (read-the))) (push (inside (eval where)) (eval what))))) (defun read-put () (let ((what (read-the (safe-read))) (adjective? (safe-read))) (case adjective? (in (push (inside where) what)) (on (push (surface where) what)) (t (error "Expecting adjective (in or on)."))))) (defun read-named () (push (setf *name* (safe-read)) *names*)) (defun read-look () (ignore-errors (let ((word (safe-read))) (setf *it* (evaluate-symbol word) it *it) (format t "You see: ") (case it ((in inside) (let ((thing (read-statement))) (inside thing))) ((on over) (let ((thing (read-statement))) (on thing))) (under (let ((thing (read-statement))) (under thing))) (at (let ((thing (read-statement))) (description thing))) (go (description *positition*)))))) (defun safe-read (&optional prompt) (let (*read-eval*) (when prompt (princ prompt)) (read))) (defun evaluate-symbol (s registers) (setf *it* (multiple-value-bind (v found) (gethash s registers) (if found v (make-instance :Thing :name s))))) (defvar *names*) (defvar *whats*) (defun commit () (let* ((*name* (pop *names*)) (*what* (pop *whats*)) thing (make-instance :Thing :name *name* :what *what*))) (format t "Setting ~S to ~S.~%" *name* thing) (when *name* (set *name* thing)) (setf (gethash *what* *registers*) thing *it* thing it *it*))) (defvar me (make-instance :Thing :name :|Burton| :what :person :description "The Owner.")) (defun read-statement (&optional prompt) (let ((word (safe-read prompt)) name what it (registers (make-hash-table))) (case word ((go done end) (commit)) (is (push *name* *names*) (push *what* *whats*) (commit) (read-statement)) (a (read-a (safe-read))) (an (read-an (safe-read))) (put (read-put)) (the (let ((thing (safe-read))) (setf (gethash thing registers) (evaluate-symbol thing registers)))) (look (format t "~A" (read-look))) (named (read-named)) (t (format t "~A" (eval word)))))) (loop (print (read-statement "=> ")))
Burton Samograd