/[lmud]/lmud/attributes.lisp
ViewVC logotype

Contents of /lmud/attributes.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show annotations)
Sat Dec 27 08:56:56 2003 UTC (10 years, 3 months ago) by james
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +54 -59 lines
Redone another time, and threw away most of the old code. Now all attributes
are just *instances* of the ATTRIBUTE class with their types encoded in a
slot. This looks simpler, and anyway it's easier to understand and keep track
of.
1 ;;;; attributes.lisp -- Attributes for living things.
2 ;;;;
3 ;;;; $Id: attributes.lisp,v 1.3 2003/12/27 08:56:56 james Exp $
4 ;;;;
5 ;;;; Copyfnord (K) 3167 - 3169 James A. Crippen <james@unlambda.com>
6 ;;;;
7 ;;;; This software is in the Public Domain. If you break it you get to keep
8 ;;;; both pieces.
9 ;;;;
10 ;;;; Attributes for living things, eg hit points, mana, etc. Adding anything
11 ;;;; that doesn't behave like an instance of the ATTRIBUTE class will be a
12 ;;;; real PITA to make fit in with the rest.
13
14 (in-package #:lmud-internals)
15
16 (defconstant +default-attribute-value+ 1)
17
18 (defvar *attributes* '(make-hash-table))
19
20 (defun attributes ()
21 (loop for i being each hash-key of *attributes*
22 collect i))
23
24 (deftype attribute-type ()
25 `(or nil (member ,@(attributes))))
26
27 (defun define-attribute (type &optional abbrev)
28 (let ((name (symbol-name type))
29 (abv (if (and (not (null abbrev)) (stringp abbrev))
30 abbrev
31 (subseq name 0 3))))
32 (setf (gethash type *attributes*) (list name abv))))
33
34 (define-attribute experience "exp")
35 (define-attribute hitpoints "hp")
36 (define-attribute mana "mp")
37 (define-attribute strength "str")
38 (define-attribute dexterity "dex")
39 (define-attribute intelligence "int")
40 (define-attribute wisdom "wis")
41 (define-attribute stamina "sta")
42 (define-attribute charisma "chr")
43 (define-attribute attack "att")
44 (define-attribute defense "def")
45
46 (defclass attribute ()
47 ((type :type attribute-types :initarg :type :initform nil :accessor attribute-type)
48 (name :type string :initarg :name :initform "" :accessor attribute-name)
49 (abbrev :type string :initarg :abbrev :initform "" :accessor attribute-abbrev)
50 (value :type (integer 0 *) :initarg :value :initform 0 :accessor attribute-value)))
51
52 (defun make-attribute (type value)
53 (let ((attrib (gethash type *attributes*)))
54 (make-instance 'attribute
55 :type type
56 :name (car attrib)
57 :abbrev (cadr attrib)
58 :value value)))
59
60 (defun make-attributes-list ()
61 (list (loop for a in (attributes)
62 (make-attribute a +default-attribute-value+))))
63
64 (defclass attributes-mixin ()
65 ((base-attributes :initarg :base-attributes :accessor base-attributes :initform nil)
66 (current-attributes :initarg :current-attributes :accessor current-attributes :initform nil)
67 (max-attributes :initarg :max-attributes :accessor max-attributes :initform nil)
68 (attribute-mods :initarg :attribute-mods :accessor attribute-mods :initform nil)))
69
70 (defmethod initialize-instance :after ((am attributes-mixin))
71 (with-slots ((base base-attributes) (current current-attributes)
72 (max max-attributes) (mod mod-attributes))
73 am
74 (if (null base) (setf base (make-attributes-list)))
75 (if (null current) (setf current (copy-attributes-list base)))
76 (if (null max) (setf max (copy-attributes-list base)))))

  ViewVC Help
Powered by ViewVC 1.1.5