.gitignore: Also ignore Metapost output.

[dnd] / pc.lisp

(defun decode-percent-table (table)
  (let ((base 0))
    (mapcar (lambda (i)
	      (prog1
		  (cons (- (car i) base) (cdr i))
		(setf base (car i))))
	    table)))

(defparameter weapons
  '((  9  "Axe, battle")
    ( 15  "Axe, hand")
    ( 17  "Axe, hand (returning)")
    ( 20  "Blackjack")
    ( 22  "Bola")
    ( 23  "Bola (returning)")
    ( 28  "Club")
    ( 40  "Dagger")
    ( 43  "Dagger (returning)")
    ( 53  "Hammer, war")
    ( 56  "Hammer, war (returning)")
    ( 59  "Javelin")
    ( 60  "Javelin (returning)")
    ( 64  "Lance")
    ( 76  "Mace")
    ( 78  "Net")
    ( 79  "Net (returning)")
    ( 84  "Polearm")
    ( 94  "Spear")
    ( 97  "Spear (returning)")
    (100  "Whip")))

(defparameter new-weapons
  '((9 "D" "Axe, battle")
    (6 "B" "Axe, hand")
    (2 "B" "Axe, hand (returning)")
    (3 "C" "Blackjack")
    (2 "B" "Bola")
    (1 "B" "Bola (returning)")
    (5 "C" "Club")
    (12 "B" "Dagger")
    (3 "B" "Dagger (returning)")
    (4 "C" "Flail, one-handed")
    (2 "D" "Flail, two-handed")
    (3 "D" "Halberd")
    (10 "C" "Hammer, war")
    (3 "B" "Javelin")
    (1 "B" "Javelin (returning)")
    (4 "D" "Lance")
    (7 "C" "Mace")
    (5 "C" "Morning star")
    (2 "B" "Net")
    (1 "B" "Net (returning)")
    (3 "D" "Pike")
    (2 "D" "Pole axe")
    (10 "B" "Spear")
    (3 "B" "Spear (returning)")
    (3 "C" "Whip")))

(defun normalize-percent-table (table)
  (let* ((max (reduce #'+ (mapcar #'car table)))
	 (aug (mapcar (lambda (i)
			(let* ((ideal (* 100 (/ (car i) max)))
			       (actual (max 1 (round ideal))))
			  (list* (- actual ideal) actual (cdr i))))
		      table))
	 (tot (reduce #'+ (mapcar #'cadr aug))))
    (loop
      (let ((dir (signum (- 100 tot)))
	    (best nil)
	    (best-diff nil)
	    (nbest 0))
	(when (zerop dir)
	  (return))
	(dolist (i aug)
	  (when (> (cadr i) 1)
	    (let ((diff (abs (- (car i) dir))))
	      (cond ((or (null best-diff) (< diff best-diff))
		     (setf best-diff diff
			   best i
			   nbest 1))
		    ((and (= diff best-diff)
			  (zerop (random (1+ nbest))))
		     (setf best i)
		     (incf nbest))))))
	(unless best
	  (error "Can't normalize this table!"))
	(decf (car best) dir)
	(incf (cadr best) dir)
	(incf tot dir)))
    (mapcar #'cdr aug)))

(defun print-percent-table (table)
  (let* ((rangetab (let ((base 1))
		     (flet ((percentage (n)
			      (format nil "~@2,,,'0A"
				      (if (= n 100) 0 n))))
		       (mapcar (lambda (i)
				 (prog1
				     (cons (if (= (car i) 1)
					       (format nil "  ~A  "
						       (percentage base))
					       (format nil "~A--~A"
						       (percentage base)
						       (percentage (+ base
								      (car i)
								      -1))))
					   (mapcar #'princ-to-string
						   (cdr i)))
				   (incf base (car i))))
			       table))))
	 (widths (reduce (lambda (acc item)
			   (format t "*** ~S~%" item)
			   (mapcar #'max acc (mapcar #'length item)))
			 rangetab
			 :initial-value (mapcar (constantly 0)
						(car rangetab))))
	 (linesep nil))
    (dolist (item rangetab)
      (when linesep
	(write-string " \\\\ \\hlx{+}")
	(terpri))
      (write-string "   ")
      (loop with sep = nil
	    for w in widths
	    and i in item
	    when sep do (format t " & ")
	    do (format t "~vA" w i)
	       (setf sep t))
      (setf linesep t))
    (when linesep
      (write-string " \\\\ \\hlx*{vh}")
      (terpri))))