IF engine rudiments, Common Lisp

Language: Layout:

;;; Wee!

;; To whomever may be reading this: I haven't made the parser, quite obviously, so everything is yet being tested by way of functions!
;; (is it "whomever" or "whoever"? it looks kinda awkward when you say it this way, doesn't it?)

;; Exits should be an assoc list where the cdr is another room object 
(defclass my-room ()
    ((name :initarg :name 
           :reader room-name)
     (description :initarg :description
                  :reader room-descr)
     (exits :initarg :exits 
            :accessor room-exits)
     (objects :initarg :contains
              :initform nil
              :accessor stuff-in-room))
    (:documentation "A basic room here"))

;; TODO make actions for the objects!
(defclass game-object ()
    ((name :initarg :name
           :reader obj-name)
     (description :initarg :description
                  :reader obj-descr)))

(defclass container (game-object)
    ((open :initarg :open
            :initform nil
            :accessor openp)
     (contents :initarg :contents
               :initform '()
               :accessor contents)))

(defvar *current-room*)
(defvar *inventory*)

(defun walk (direction)
    (let ((dest-room (assoc direction (room-exits *current-room*))))
         (if dest-room
             (progn 
                 (setf *current-room* (cdr dest-room))
                 (format t "You walk ~(~a~) to ~a~%" direction (room-name *current-room*)))
             (print "You can't go that way!"))))

(defun look (&optional (room *current-room*))
    (format t "~a~%" (room-descr room))
    ;;; TODO print exits
    (if (stuff-in-room room)
        ; TODO Obvs this part can do a whole lot better!
        (format t "~{You see ~@(~a~) here.~%~}" (mapcar #'obj-name (stuff-in-room room)))))

(defun inventory ()
    (format t "You are carrying:~%~{ ~a.~%~}" (mapcar #'obj-name *inventory*)))

(defgeneric examine (obj))

(defmethod examine (obj)
    (format t "~a~%" (obj-descr obj)))

(defmethod examine ((c container))
    (if (openp c)
        (progn
            (format t "~a~%" (obj-descr c))
            (if (contents c)
                (format t "Inside it you see:~%~{~a~%~}" (mapcar #'obj-name (contents c)))
                (format t "It is open and empty~%")))
        (format t "It is closed~%")))

(defun take (obj) 
    (let ((stuff (stuff-in-room *current-room*)))
        (if (or (member obj stuff) (member obj *inventory*))
            (progn (push obj *inventory*)
                   (setf (stuff-in-room *current-room*) (remove obj stuff))
                   (format t "Took ~a~%" (obj-name obj)))
            (format t "There's no ~a here~%" (obj-name obj)))))

(defun drop (obj) 
    (if (member obj *inventory*)
        (progn (setf *inventory* (remove obj *inventory*))
               (push obj (stuff-in-room *current-room*))
               (format t "You drop ~a.~%" (obj-name obj)))
        (format t "You are not carrying ~a.~%" (obj-name obj))))

(defgeneric open-box (cont &optional key)
    (:documentation "Meant for container objects"))

(defmethod open-box ((c container) &optional key)
    (if (openp c)
        (format t "It is already open~%")
        (progn (setf (openp c) t)
            (format t "You open ~a.~%" (obj-name c)))))

;;; :O

(setq *nil-room* (make-instance 'my-room 
                                :name "NIL Room"
                                :description "This is the NIL Room, wooooooo!"
                                :exits nil))

(setq *bar* (make-instance 'game-object
                           :name "Bar" 
                           :description "It's a bar!"))

(setq *goo* (make-instance 'game-object 
                           :name "Goo"
                           :description "Some goo"))
(setq *O* (make-instance 'game-object
                         :name "O"
                         :description "It's an O"))

(setq *box* (make-instance 'container
                           :name "The Box"
                           :description "A simple cardboard box, a little worn"
                           :contents '(*O*)))
                           
(setq *junk-room* (make-instance 'my-room 
                                 :name "Junk Room" 
                                 :description "A room full of junk"
                                 :exits (list (cons :out *nil-room*))
                                 :contains (list *goo* *bar*)))

(setq *room* (make-instance 'my-room 
                            :name "Room" 
                            :description "This is The Room, from which all other rooms stem"
                            :exits (list (cons :north *junk-room*)
                                         (cons :south *nil-room*))))

(setf *current-room* *room*)
(setf *inventory* NIL)

(look)
(take *goo*)
(walk :north)
(look)
(examine *goo*)
(take *goo*)
(look)
(inventory)
(walk :out)
(look)
(inventory)
(examine *goo*)
(drop *goo*)
(drop *bar*) 
(look)

[ + ] Show input
Absolute running time: 0.1 sec, cpu time: 0.04 sec, memory peak: 6 Mb, absolute service time: 0,11 sec