diff --git a/lisp/atlantis.lisp b/lisp/atlantis.lisp index e22c126..2bcbb5b 100644 --- a/lisp/atlantis.lisp +++ b/lisp/atlantis.lisp @@ -21,8 +21,7 @@ (while (not (numberp (input port))) (format t "~&Not a number: ~A. Please reenter:" port)) (format t "~&Loading file ~S on port ~A" world-file port) - (load-file world-file) - (break)) + (load-file world-file)) (defun join-game () "Join a running game on the server" diff --git a/lisp/atlantis.lisp b/lisp/atlantis.lisp index e22c126..2bcbb5b 100644 --- a/lisp/atlantis.lisp +++ b/lisp/atlantis.lisp @@ -21,8 +21,7 @@ (while (not (numberp (input port))) (format t "~&Not a number: ~A. Please reenter:" port)) (format t "~&Loading file ~S on port ~A" world-file port) - (load-file world-file) - (break)) + (load-file world-file)) (defun join-game () "Join a running game on the server" diff --git a/lisp/game-objects.lisp b/lisp/game-objects.lisp index 9377894..b71a1a3 100644 --- a/lisp/game-objects.lisp +++ b/lisp/game-objects.lisp @@ -35,6 +35,7 @@ (description "") (function NIL)) + (defun set-object-attribute (game-object property value) "Set the attribute 'property' of 'game-object' to 'value'" ;; Here follows Lisp magic :D (that took ages to get right...) @@ -45,5 +46,9 @@ (symbol-name (type-of game-object)) "-" (if (stringp property) property (symbol-name property)))))) - (eval `(setf (,command ,game-object) ,value)))) - + ;; XXX This following section is rather ugly... + (eval `(if (or (null (,command ,game-object)) + (listp (,command ,game-object))) + (setf (,command ,game-object) + (append (,command ,game-object) '(,value))) + (setf (,command ,game-object) ,value))))) diff --git a/lisp/atlantis.lisp b/lisp/atlantis.lisp index e22c126..2bcbb5b 100644 --- a/lisp/atlantis.lisp +++ b/lisp/atlantis.lisp @@ -21,8 +21,7 @@ (while (not (numberp (input port))) (format t "~&Not a number: ~A. Please reenter:" port)) (format t "~&Loading file ~S on port ~A" world-file port) - (load-file world-file) - (break)) + (load-file world-file)) (defun join-game () "Join a running game on the server" diff --git a/lisp/game-objects.lisp b/lisp/game-objects.lisp index 9377894..b71a1a3 100644 --- a/lisp/game-objects.lisp +++ b/lisp/game-objects.lisp @@ -35,6 +35,7 @@ (description "") (function NIL)) + (defun set-object-attribute (game-object property value) "Set the attribute 'property' of 'game-object' to 'value'" ;; Here follows Lisp magic :D (that took ages to get right...) @@ -45,5 +46,9 @@ (symbol-name (type-of game-object)) "-" (if (stringp property) property (symbol-name property)))))) - (eval `(setf (,command ,game-object) ,value)))) - + ;; XXX This following section is rather ugly... + (eval `(if (or (null (,command ,game-object)) + (listp (,command ,game-object))) + (setf (,command ,game-object) + (append (,command ,game-object) '(,value))) + (setf (,command ,game-object) ,value))))) diff --git a/lisp/interpreter.lisp b/lisp/interpreter.lisp index bd97847..eecc9e5 100644 --- a/lisp/interpreter.lisp +++ b/lisp/interpreter.lisp @@ -26,38 +26,38 @@ (let ((world-directory NIL)) (defun load-file (file-name) "Load and interpret an ATL source file" - ; save/load the current working directory + ;; save/load the current working directory (if (null (pathname-directory file-name)) (setf file-name (make-pathname :directory world-directory :name (pathname-name file-name) :type (pathname-type file-name))) (setf world-directory (pathname-directory file-name))) - ; parse the ATL file + ;; parse the ATL file (do* ((line-nr 0 (1+ line-nr)) (source (load-text-file file-name)) (line (nth line-nr source) (nth line-nr source)) (current-object NIL)) ((= line-nr (length source)) NIL) - ;concatenate string arguments spanning several lines + ;; concatenate string arguments spanning several lines (while (= (count-vector-instances #\" line) 1) (incf line-nr) (setf line (concatenate 'string line (nth line-nr source)))) (cond ((zerop (length line)) ;; TODO - ;(when current-object (add-game-object current-object)) + (when current-object (add-game-object current-object)) (setf current-object NIL)) ((eql (aref line 0) #\;)) ;Comments are ignored - ; interpret a define command + ;; interpret a define command ((not (or (eql (aref line 0) #\;) (eql (aref line 0) #\SPACE) (eql (aref line 0) #\TAB))) (setf current-object (funcall (symbol-function (read-from-string line)) - ; here follows a kludge to work around a clisp bug (the - ; :start keyword in read-from-string is not recognized) + ;; this is a kludge to work around a clisp bug (not + ;; recognizing the :start keyword in read-from-string) (read-from-string (second (cut-string line (find-char #\space line))))))) - ; interpret an option command + ;; interpret an option command ((or (eql (aref line 0) #\Space) (eql (aref line 0) #\Tab)) (setf line (string-left-trim '(#\Space #\Tab) line)) @@ -65,5 +65,5 @@ (read-from-string (second (cut-string line (find-char #\space line)))))) (T (format t "~&ERROR: unrecognized syntax on line ~A: '~A'" - ;can't happen + ;; can't happen (1+ line-nr) line)))))) diff --git a/lisp/atlantis.lisp b/lisp/atlantis.lisp index e22c126..2bcbb5b 100644 --- a/lisp/atlantis.lisp +++ b/lisp/atlantis.lisp @@ -21,8 +21,7 @@ (while (not (numberp (input port))) (format t "~&Not a number: ~A. Please reenter:" port)) (format t "~&Loading file ~S on port ~A" world-file port) - (load-file world-file) - (break)) + (load-file world-file)) (defun join-game () "Join a running game on the server" diff --git a/lisp/game-objects.lisp b/lisp/game-objects.lisp index 9377894..b71a1a3 100644 --- a/lisp/game-objects.lisp +++ b/lisp/game-objects.lisp @@ -35,6 +35,7 @@ (description "") (function NIL)) + (defun set-object-attribute (game-object property value) "Set the attribute 'property' of 'game-object' to 'value'" ;; Here follows Lisp magic :D (that took ages to get right...) @@ -45,5 +46,9 @@ (symbol-name (type-of game-object)) "-" (if (stringp property) property (symbol-name property)))))) - (eval `(setf (,command ,game-object) ,value)))) - + ;; XXX This following section is rather ugly... + (eval `(if (or (null (,command ,game-object)) + (listp (,command ,game-object))) + (setf (,command ,game-object) + (append (,command ,game-object) '(,value))) + (setf (,command ,game-object) ,value))))) diff --git a/lisp/interpreter.lisp b/lisp/interpreter.lisp index bd97847..eecc9e5 100644 --- a/lisp/interpreter.lisp +++ b/lisp/interpreter.lisp @@ -26,38 +26,38 @@ (let ((world-directory NIL)) (defun load-file (file-name) "Load and interpret an ATL source file" - ; save/load the current working directory + ;; save/load the current working directory (if (null (pathname-directory file-name)) (setf file-name (make-pathname :directory world-directory :name (pathname-name file-name) :type (pathname-type file-name))) (setf world-directory (pathname-directory file-name))) - ; parse the ATL file + ;; parse the ATL file (do* ((line-nr 0 (1+ line-nr)) (source (load-text-file file-name)) (line (nth line-nr source) (nth line-nr source)) (current-object NIL)) ((= line-nr (length source)) NIL) - ;concatenate string arguments spanning several lines + ;; concatenate string arguments spanning several lines (while (= (count-vector-instances #\" line) 1) (incf line-nr) (setf line (concatenate 'string line (nth line-nr source)))) (cond ((zerop (length line)) ;; TODO - ;(when current-object (add-game-object current-object)) + (when current-object (add-game-object current-object)) (setf current-object NIL)) ((eql (aref line 0) #\;)) ;Comments are ignored - ; interpret a define command + ;; interpret a define command ((not (or (eql (aref line 0) #\;) (eql (aref line 0) #\SPACE) (eql (aref line 0) #\TAB))) (setf current-object (funcall (symbol-function (read-from-string line)) - ; here follows a kludge to work around a clisp bug (the - ; :start keyword in read-from-string is not recognized) + ;; this is a kludge to work around a clisp bug (not + ;; recognizing the :start keyword in read-from-string) (read-from-string (second (cut-string line (find-char #\space line))))))) - ; interpret an option command + ;; interpret an option command ((or (eql (aref line 0) #\Space) (eql (aref line 0) #\Tab)) (setf line (string-left-trim '(#\Space #\Tab) line)) @@ -65,5 +65,5 @@ (read-from-string (second (cut-string line (find-char #\space line)))))) (T (format t "~&ERROR: unrecognized syntax on line ~A: '~A'" - ;can't happen + ;; can't happen (1+ line-nr) line)))))) diff --git a/lisp/world.lisp b/lisp/world.lisp index 6fd4639..c9eea68 100644 --- a/lisp/world.lisp +++ b/lisp/world.lisp @@ -25,18 +25,16 @@ (setf *world* (make-world)) - -;FIXME Needs work -(defmacro add-game-object (game-object) - "Add a game-object to the *world*" - (let ((attribute-list - (cond ((player-p game-object) '(world-players *world*)) - ((place-p game-object) '(world-places *world*)) - ((monster-p game-object) '(world-monsters *world*)) - ((npc-p game-object) '(world-npcs *world*)) - ((item-p game-object) '(world-items *world*))))) - `(setf ,attribute-list (append ,attribute-list ,game-object)))) - +(defun add-game-object (game-object) + "Add 'game-object' to *world*" + ;; XXX: Very similar in structure to the function set-object-attribute in + ;; game-objects.lisp. Can that be abstracted away into a macro or some such? + (let ((world-list (read-from-string + (concatenate 'string "world-" + (symbol-name (type-of game-object)) "s")))) + (eval `(setf (,world-list *world*) + (append (,world-list *world*) (list ,game-object)))))) + ; TODO -(defmacro get-game-object (object-name)) +(defun get-game-object (object-name))