Commits

Paul Sexton committed aaf278d

New functions:
- Fixed: ptables are updated when ptabled-classes are redefined, not
just when they are first created.
- 'all-ptables', returns a list of all currently recognised ptables.
- expand-ptable!: if argument is a ptable, call 'random-entry', otherwise
return argument unchanged.
'random-entry' can now be called with a symbol as its argument.

Added an example to README.

Comments (0)

Files changed (2)

 up piecewise. A "ptabled-class" metaclass is also provided which allows classes
 to insert entries for themselves into ptables.
 
-(define-ptable
+    :::lisp
+    (define-ptable :tbl-foo
+      (:bar :common)
+      (:baz :rare))
+
+    :::lisp
+    (defclass foo ()
+      ((...slots...))
+      (:metaclass ptabled-class)
+      (:ptable-entries ((:tbl-foo :uncommon) (:tbl-bar :rare))))
+
+## Format of a ptable entry
+
+    :::lisp
+    (VALUE :rarity RARITY
+           :min-level MIN-LEVEL
+           :peaks (PEAK [PEAK...]))
+
+Where:
+
+* `RARITY` is a positive integer or one of the keywords `:common`, `:uncommon`,
+  `:rare` or `:very-rare`.
+* `MIN-LEVEL` is an integer.
+* `PEAKS` is a list of one or more integers.
 
 ## Rarity
 
 (rarity 1). Dragons are very rare (rarity 25). The other monsters have rarities
 between these extremes.
 
-Monster  Rarity  Frequency  Probability
-                 1/rarity   freq/1.89*100
-rat      1       1.00        53%
-goblin   2       0.50        27%
-orc      4       0.25        13%
-spectre  10      0.10         5%
-dragon   25      0.04         2%
-                 ----       ----
-                 1.89       100%
+
+| Monster | Rarity | Frequency |   Probability |
+|         |        |  1/rarity | freq/1.89*100 |
+------------------------------------------------
+| rat     |      1 |      1.00 |           53% |
+| goblin  |      2 |      0.50 |           27% |
+| orc     |      4 |      0.25 |           13% |
+| spectre |     10 |      0.10 |            5% |
+| dragon  |     25 |      0.04 |            2% |
+------------------------------------------------
+|         |        |      1.89 |          100% |
+
 
 When randomly choosing a monster from the table, a rat will be chosen 53% of
 the time, a goblin 27% of the time, and so on.
    #:pentry-min-level
    #:pentry-peaks
    #:symbol->ptable
+   #:all-ptables
    #:random-entry
+   #:expand-ptable!
    #:ptable-add-entry
    #:ptable-replace-entry
    #:ptable-contents
                   (t nil))))))
 
 
+(defun all-ptables ()
+  (hash-table-values *ptables*))
+
+
 (defmethod ptable-contents ((tbl ptable))
   (iterate
     (for entry in (ptable-entries tbl))
           (error "Probabilities of ptable ~S add up to < 1 " tbl)))))))
 
 
+(defmethod random-entry ((sym symbol) &optional level)
+  (unless (null sym)
+    (random-entry (symbol->ptable sym) level)))
+
+
 (defun pentry-choose-count (cnt)
   (typecase cnt
     (real cnt)
 
 
 
+(defun expand-ptable! (s &optional level)
+  "If S is a ptable or ptable symbol, return a random entry from that ptable;
+otherwise return S unaltered."
+  (typecase s
+    (null nil)
+    (symbol (if (symbol->ptable s)
+                (random-entry (symbol->ptable s) level)
+                s))
+    (ptable (random-entry s level))
+    (otherwise s)))
+
+
+
 ;;;; <<Ptabled classes>> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
 (defclass ptabled-class (standard-class)
   ((ptable-entries :initform nil :initarg :ptable-entries
-                   :accessor ptable-entries
+                   ;;:accessor ptable-entries
                    :documentation "List of PTABLE-ENTRIES. Each PTABLE-ENTRY
 is a list of the form (PTABLE-SYM RARITY [other ptable-entry args...]).
 In fact this list will always be embedded inside a further list, because
   t)
 
 
-(defmethod initialize-instance :after ((tc ptabled-class)
-                                       &key
-                                       &allow-other-keys)
+(defmethod process-ptable-entries-for-class ((tc ptabled-class))
   (iterate
     (for (ptable-sym . entry-body) in (ptable-entries tc :inherited? t))
     (when ptable-sym
                                    entry-body)))))
 
 
+(defmethod initialize-instance :after ((tc ptabled-class)
+                                       &key
+                                       &allow-other-keys)
+  (process-ptable-entries-for-class tc))
+
+
+(defmethod reinitialize-instance :after ((tc ptabled-class)
+                                       &key
+                                       &allow-other-keys)
+  (process-ptable-entries-for-class tc))
+
+
 (defun* (ptabled-class? -> boolean) (c)
   (typep c 'ptabled-class))
 
       (t
        (error "Don't know how to get ptable-entries of `~S'" sym)))))
 
-
-(defmethod (setf ptable-entries) (value (tbl ptable))
-  (setf (slot-value tbl 'ptable-entries) value))
+(defgeneric (setf ptable-entries) (value tbl)
+  (:method (value (tbl ptable))
+    (setf (slot-value tbl 'ptable-entries) value)))