;;; ;;; Atlantis is a framework for creating multi-user dungeon worlds. ;;; This is the Common Lisp implementation. ;;; ;;; This file contains all the various kinds of in-game objects like ;;; places, monsters, NPCs, items... ;;; ;;; Licensed under the terms of the MIT license. ;;; author: Daniel Vedder ;;; date: 15/05/2015 ;;; (defstruct place (name "") (description "") ;; Missing 's' in the following list names due to parsing issues (neighbour NIL) (player NIL) (item NIL) (monster NIL) (npc NIL) (dark NIL) (function "")) ;;; WORK IN PROGRESS >>> (defstruct npc (name "") (description "") (says "") (sells NIL) (quest "")) (defstruct monster (name "") (description "") (health 0) (strength 0) (dexterity 0) (aggression 0) (spawn-probability 0) (item NIL) (weapon "") (armour-class 0)) (defstruct item (name "") (description "") (cost 0) (weapon "no") (function NIL)) (defstruct weapon (name "") (description "") (type "") (damage 0)) (defstruct quest (name "") (say-before "") (say-after "") (proof-item NIL) (reward-item NIL) (money 0) (experience 0)) (defstruct game-function (name "") (docstring "") (place NIL) (player NIL) (print "")) (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...) ;; XXX It's not elegant to call (eval) explicitly, but in this case I can't ;; find a way to avoid it - I needed a mix between a macro and a function (let ((command (build-symbol (type-of game-object) "-" property))) (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))))) (defun remove-object-attribute (game-object property value) "Remove 'value' from the attribute 'property' in 'game-object'" ;; Same comment applies as above (let ((command (build-symbol (type-of game-object) "-" property))) (eval `(cond ((listp (,command ,game-object)) (setf (,command ,game-object) (remove-first-if #'(lambda (x) (equalp x ,value)) (,command ,game-object)))) ((numberp (,command ,game-object)) (setf (,command ,game-object) 0)) ((stringp (,command ,game-object)) (setf (,command ,game-object) "")) (t (setf (,command ,game-object) NIL)))))) (defun objectify-name-list (object-type name-list) "Turn all the string names in name-list into instances of the object type" ;; Basically the inverse of a make-list-function function (cf. util.lisp) (let ((objects NIL) (copy-fn (build-symbol "copy-" object-type))) (dolist (n name-list objects) (if (stringp n) (setf objects (cons (funcall copy-fn (get-game-object object-type n)) objects)) (setf objects (cons n objects)))))) (defun objectify-place-monsters (place) "Objectify all the monsters in this place" (let* ((p (if (place-p place) place (get-game-object 'place place)))) (setf (place-monster p) (objectify-name-list 'monster (place-monster p))) p)) (let ((list-function (make-list-function 'place NIL))) (defun list-place-objects (object-type place) "Get a list of the names of all the place's objects of this type." (funcall list-function object-type place))) (defun get-object-description (object-name place) "Get a description of this object in place (or nil if not there)" (let ((p (if (place-p place) place (get-game-object 'place place)))) (cond ((member object-name (list-place-objects 'item p) :test #'equalp) (item-description (get-game-object 'item object-name))) ((member object-name (list-place-objects 'monster p) :test #'equalp) (monster-description (get-game-object 'monster object-name))) ((member object-name (list-place-objects 'npc p) :test #'equalp) (npc-description (get-game-object 'npc object-name))) (t NIL)))) (defun run-game-function (function player) "Execute this game function" (let* ((fn (if (game-function-p function) function (get-game-object 'game-function function))) (player (if (player-p player) player (get-game-object 'player player))) (place (get-game-object 'place (player-place player)))) (dolist (game-obj (list player place)) ;; Iterate through each element in the function that modifies ;; this game object (dolist (element (funcall (build-symbol "game-function-" (type-of game-obj)) fn)) (let* ((element (if (listp element) element (list element))) (attr (first element)) (value (second element)) ;; FIXME +1 gets transformed to "1"... (mod (aref (to-string value) 0)) (orig-value (funcall (build-symbol (type-of game-obj) #\- attr) game-obj))) ;; Update the value of the specified attribute (if (= (length element) 1) (set-object-attribute game-obj attr T) (if (or (eq mod #\+) (eq mod #\-)) (set-object-attribute game-obj attr (+ orig-value value)) (set-object-attribute game-obj attr value))))))))