~mdw / dnd / blame
| 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))) |