Commit | Line | Data |
---|---|---|
46d528a4 MW |
1 | (defconstant xp-table |
2 | '(((0 . (0 +)) 5 1) | |
3 | ((1 . 1) 10 3) | |
4 | (((1 +) . (1 +)) 15 4) | |
5 | ((2 . 2) 20 5) | |
6 | (((2 +) . (2 +)) 25 10) | |
7 | ((3 . 3) 30 15) | |
8 | (((3 +) . (3 +)) 50 25) | |
9 | ((4 . 4) 75 50) | |
10 | (((4 +) . (4 +)) 125 75) | |
11 | ((5 . 5) 175 125) | |
12 | (((5 +) . (5 +)) 225 175) | |
13 | ((6 . 6) 275 225) | |
14 | (((6 +) . (6 +)) 350 300) | |
15 | ((7 . 7) 450 400) | |
16 | (((7 +) . (7 +)) 550 475) | |
17 | ((8 . 8) 650 550) | |
18 | (((8 +) . (8 +)) 775 625) | |
19 | ((9 . 9) 900 700) | |
20 | (((9 +) . 10) 1000 750) | |
21 | (((10 +) . 11) 1100 800) | |
22 | (((11 +) . 12) 1250 875) | |
23 | (((12 +) . 13) 1350 950) | |
24 | (((13 +) . 14) 1500 1000) | |
25 | (((14 +) . 15) 1650 1050) | |
26 | (((15 +) . 16) 1850 1100) | |
27 | (((16 +) . 17) 2000 1150) | |
28 | (((17 +) . 18) 2125 1350) | |
29 | (((18 +) . 19) 2250 1550) | |
30 | (((19 +) . 20) 2375 1800) | |
31 | (((20 +) . 21) 2500 2000))) | |
32 | ||
33 | (defun parse-hd-spec (spec &optional start end) | |
34 | (unless start (setf start 0)) | |
35 | (unless end (setf end (length spec))) | |
36 | (multiple-value-bind | |
37 | (hd e) | |
38 | (parse-integer spec :start start :end end :junk-allowed t) | |
39 | (when (and (< e end) | |
40 | (char= (char spec e) #\+)) | |
41 | (incf e) | |
42 | (multiple-value-bind | |
43 | (hunoz ee) | |
44 | (parse-integer spec :start e :end end :junk-allowed t) | |
45 | (declare (ignore hunoz)) | |
46 | (setf e ee) | |
47 | (setf hd (list hd '+)))) | |
48 | (unless (loop for i from e below end | |
49 | never (char/= (char spec i) #\*)) | |
50 | (error "bad hit dice string")) | |
51 | (let ((stars (- end e))) | |
52 | (flet ((hd<= (a b) | |
53 | (let ((aa (if (consp a) (car a) a)) | |
54 | (bb (if (consp b) (car b) b))) | |
55 | (or (< aa bb) | |
56 | (and (= aa bb) | |
57 | (or (consp a) | |
58 | (not (consp b)))))))) | |
59 | (loop for ((lo . hi) base bonus) in xp-table | |
60 | when (and (hd<= lo hd) | |
61 | (hd<= hd hi)) | |
62 | return (+ base (* stars bonus)) | |
63 | finally (let* ((hd-base (if (consp hd) (car hd) hd)) | |
64 | (hd-plus (if (consp hd) 1 0)) | |
65 | (steps (+ hd-base -21 hd-plus))) | |
66 | (return (+ 2500 | |
67 | (* 250 steps) | |
68 | (* (+ 2000 (* 250 steps)) stars))))))))) | |
69 | ||
70 | (defmacro hd (sym) | |
71 | `(parse-hd-spec ',(princ-to-string sym))) |