Commit | Line | Data |
---|---|---|
46d528a4 MW |
1 | (defun decode-percent-table (table) |
2 | (let ((base 0)) | |
3 | (mapcar (lambda (i) | |
4 | (prog1 | |
5 | (cons (- (car i) base) (cdr i)) | |
6 | (setf base (car i)))) | |
7 | table))) | |
8 | ||
9 | (defparameter weapons | |
10 | '(( 9 "Axe, battle") | |
11 | ( 15 "Axe, hand") | |
12 | ( 17 "Axe, hand (returning)") | |
13 | ( 20 "Blackjack") | |
14 | ( 22 "Bola") | |
15 | ( 23 "Bola (returning)") | |
16 | ( 28 "Club") | |
17 | ( 40 "Dagger") | |
18 | ( 43 "Dagger (returning)") | |
19 | ( 53 "Hammer, war") | |
20 | ( 56 "Hammer, war (returning)") | |
21 | ( 59 "Javelin") | |
22 | ( 60 "Javelin (returning)") | |
23 | ( 64 "Lance") | |
24 | ( 76 "Mace") | |
25 | ( 78 "Net") | |
26 | ( 79 "Net (returning)") | |
27 | ( 84 "Polearm") | |
28 | ( 94 "Spear") | |
29 | ( 97 "Spear (returning)") | |
30 | (100 "Whip"))) | |
31 | ||
32 | (defparameter new-weapons | |
33 | '((9 "D" "Axe, battle") | |
34 | (6 "B" "Axe, hand") | |
35 | (2 "B" "Axe, hand (returning)") | |
36 | (3 "C" "Blackjack") | |
37 | (2 "B" "Bola") | |
38 | (1 "B" "Bola (returning)") | |
39 | (5 "C" "Club") | |
40 | (12 "B" "Dagger") | |
41 | (3 "B" "Dagger (returning)") | |
42 | (4 "C" "Flail, one-handed") | |
43 | (2 "D" "Flail, two-handed") | |
44 | (3 "D" "Halberd") | |
45 | (10 "C" "Hammer, war") | |
46 | (3 "B" "Javelin") | |
47 | (1 "B" "Javelin (returning)") | |
48 | (4 "D" "Lance") | |
49 | (7 "C" "Mace") | |
50 | (5 "C" "Morning star") | |
51 | (2 "B" "Net") | |
52 | (1 "B" "Net (returning)") | |
53 | (3 "D" "Pike") | |
54 | (2 "D" "Pole axe") | |
55 | (10 "B" "Spear") | |
56 | (3 "B" "Spear (returning)") | |
57 | (3 "C" "Whip"))) | |
58 | ||
59 | (defun normalize-percent-table (table) | |
60 | (let* ((max (reduce #'+ (mapcar #'car table))) | |
61 | (aug (mapcar (lambda (i) | |
62 | (let* ((ideal (* 100 (/ (car i) max))) | |
63 | (actual (max 1 (round ideal)))) | |
64 | (list* (- actual ideal) actual (cdr i)))) | |
65 | table)) | |
66 | (tot (reduce #'+ (mapcar #'cadr aug)))) | |
67 | (loop | |
68 | (let ((dir (signum (- 100 tot))) | |
69 | (best nil) | |
70 | (best-diff nil) | |
71 | (nbest 0)) | |
72 | (when (zerop dir) | |
73 | (return)) | |
74 | (dolist (i aug) | |
75 | (when (> (cadr i) 1) | |
76 | (let ((diff (abs (- (car i) dir)))) | |
77 | (cond ((or (null best-diff) (< diff best-diff)) | |
78 | (setf best-diff diff | |
79 | best i | |
80 | nbest 1)) | |
81 | ((and (= diff best-diff) | |
82 | (zerop (random (1+ nbest)))) | |
83 | (setf best i) | |
84 | (incf nbest)))))) | |
85 | (unless best | |
86 | (error "Can't normalize this table!")) | |
87 | (decf (car best) dir) | |
88 | (incf (cadr best) dir) | |
89 | (incf tot dir))) | |
90 | (mapcar #'cdr aug))) | |
91 | ||
92 | (defun print-percent-table (table) | |
93 | (let* ((rangetab (let ((base 1)) | |
94 | (flet ((percentage (n) | |
95 | (format nil "~@2,,,'0A" | |
96 | (if (= n 100) 0 n)))) | |
97 | (mapcar (lambda (i) | |
98 | (prog1 | |
99 | (cons (if (= (car i) 1) | |
100 | (format nil " ~A " | |
101 | (percentage base)) | |
102 | (format nil "~A--~A" | |
103 | (percentage base) | |
104 | (percentage (+ base | |
105 | (car i) | |
106 | -1)))) | |
107 | (mapcar #'princ-to-string | |
108 | (cdr i))) | |
109 | (incf base (car i)))) | |
110 | table)))) | |
111 | (widths (reduce (lambda (acc item) | |
112 | (format t "*** ~S~%" item) | |
113 | (mapcar #'max acc (mapcar #'length item))) | |
114 | rangetab | |
115 | :initial-value (mapcar (constantly 0) | |
116 | (car rangetab)))) | |
117 | (linesep nil)) | |
118 | (dolist (item rangetab) | |
119 | (when linesep | |
120 | (write-string " \\\\ \\hlx{+}") | |
121 | (terpri)) | |
122 | (write-string " ") | |
123 | (loop with sep = nil | |
124 | for w in widths | |
125 | and i in item | |
126 | when sep do (format t " & ") | |
127 | do (format t "~vA" w i) | |
128 | (setf sep t)) | |
129 | (setf linesep t)) | |
130 | (when linesep | |
131 | (write-string " \\\\ \\hlx*{vh}") | |
132 | (terpri)))) |