| 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))) |