chris/emacs-rpgdm
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

After a night or two of late hacking...

Browse source 
I have a semblance of code giving me functions to help me run my D&D
games. The README needs a lot more love, but the code is generally tidy.

Time to add some tables...
This commit is contained in:
Howard Abrams 2021-01-29 23:18:36 -08:00
commit 9411e512ce
5 changed files with 977 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

29
README.org Normal file
View file

@ -0,0 +1,29 @@
#+TITLE: Dungeon Master Support in Emacs
#+AUTHOR: Howard X. Abrams
#+EMAIL: howard.abrams@workday.com
#+DATE: 2021-01-27 January
#+TAGS: rpg
The overlap between Emacs and running a Dungeons and Dragon campaign
* Themes
** Yes/No Complications
According to [[https://www.hipstersanddragons.com/difficulty-classes-for-ability-checks-5e/][this essay]], the standard DC 15 skill check is actually /too hard/ for most situations,
The [[https://www.drivethrurpg.com/product/89534/FU-The-Freeform-Universal-RPG-Classic-rules][FU Rules]] think a attempt with randomness (what D&D calls an ability check) shouldn't be just a yes/no, but could have some /complications/, like "yes, but..." or "no, and...". I want to be able to wrap these ideas into a single interface.
** Random Items
As a DM, we
** DM Screen and Roll from my Notes
* Code
What do I have here:
- [[file:rpgdm.el][rpgdm.el]] :: Primary interface offering:
- rpgdm-yes-and-50/50
- rpgdm-skill-check given a target and a d20 dice result, returns yes/no, but possibly with complications
- rpgdm-skill-check-easy queries a rolled results, and returns a complicated yes/no for an /easy/ skill challenge
- rpgdm-skill-check-moderate
- rpgdm-skill-check-hard
- rpgdm-skill-check-difficult
- rpgdm-skill-check-impossible
- [[file:rpgdm-dice.el][rpgdm-dice]] :: All the random number generators, plus:
- =rpgdm-forward-roll= to move point to the next dice expression
- =rpgdm-roll= randomly evaluates dice expression at point, or queries for one
- =rpgdm-roll-advantage= / =rpgdm-roll-disadvantage= rolls a d20 with a modifier

305
rpgdm-dice.el Normal file
View file

@ -0,0 +1,305 @@
;;; RPG-DM-HELPER --- Help for a Dungeon Master
;;
;; Author: Howard Abrams <howard@howardabrams.com>
;; Copyright © 2018, Howard Abrams, all rights reserved.
;; Created: 15 August 2018
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Functions to help a DM use an org-mode file as the basis of
;; notes for an adventure.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
;; The basics of a dice roll is a random number from a given range. Note that if
;; we give a 6-sided die to the random number, we will end up with a range of 0
;; to 5, so we need to increase this value by 1.
(defun rpgdm--roll-die (sides)
"Rolls a die of with SIDES."
(1+ (random sides)))
;; ----------------------------------------------------------------------
;; TESTING SUPPORT
;;
;; Unit Testing for random numbers is tricky, so what I will want to do is call
;; a function a number of times. A little function that `repeatedly' calls a
;; function with arguments and returns a list of the results should be helpful.
(defun repeatedly (fn args times)
"Call a function, FN, with a list of arguments, ARGS, a number of TIMES.
Return a list of results."
(let (value)
(dotimes (number times value)
(setq value (cons (apply fn args) value)))))
;; This function will run a large number of runs and verify that all dice rolls
;; fall between two ranges. This is completely accurate, as our dice rolls could
;; be in a smaller subset, so we also check to make sure that at least one roll
;; was at each end. This should be _good enough_.
(defun rpgdm--test-rolls (fn args min max)
"Run function FN with ARGS to validate all results.
The numbers returned should be between MIN and MAX, with an
average value of AVG, if given."
(let ((rolls (repeatedly fn args 1000)))
(should (--some? (= it min) rolls))
(should (--some? (= it max) rolls))
(should (--every? (>= it min) rolls))
(should (--every? (<= it max) rolls))))
(ert-deftest rpgdm--roll-expression-test ()
"Simple test of my random number generator.
This really tests the `rpgdm--test-rolls' function."
(dolist (test-data '((4 1 4)
(6 1 6)
(8 1 8)
(20 1 20)
(100 1 100)))
(destructuring-bind (die lowest highest) test-data
(rpgdm--test-rolls #'rpgdm--roll-die (list die) lowest highest))))
;; ----------------------------------------------------------------------
;; Now that we have a `rpgdm--roll-die' function that rolls a single die. How do
;; we want multiple dice rolls. Perhaps the results should be a list, so that we
;; can easily sum them, but still have the original results of each die roll.
(defun rpgdm--roll-dice (count sides)
"Return a list of COUNT dice rolls where each die has SIDES."
(let (value)
(dotimes (_ count value)
(setq value (cons (rpgdm--roll-die sides) value)))))
(ert-deftest rpgdm--roll-dice-test ()
"Validate the `rpgdm--roll-dice' by making sure we get a list
of all die rolls, and that each number is within the range.
We can assume that `rpgdm--roll-dice' works."
(let ((results (rpgdm--roll-dice 4 6)))
(should (= (length results) 4))
(should (--every? (>= it 1) results))
(should (--every? (<= it 6) results))))
;; An RPG has checks that have multiple dice, plus a modifier (positive or
;; negative). When displaying the results, I want all the dice rolls displayed
;; differently from the modifier. Should we just assume the modifier is the
;; first or last number is the returned list?
;;
;; What if we have this function return a cons'd with the `car' be a list of the
;; rolls, and the `cdr' the modifier amount?
(defun rpgdm--roll (num-dice dice-type &optional modifier plus-minus)
"Generate a random dice roll. Return tuple where `car' is a list of rolled
results, and the `cdr' is the modifier, see `rpgdm--sum'.
The NUM-DICE is the number of DICE-TYPE to roll. The PLUS-MINUS
is a string of either '+' or '-' to affect the results with the
MODIFIER amount. If PLUS-MINUS is nil, assume MODIFIER should
be added."
(let* ((base-rolls (rpgdm--roll-dice num-dice dice-type)))
(cond ((string= "-" plus-minus) (cons base-rolls (- modifier)))
((numberp modifier) (cons base-rolls modifier))
(t (cons base-rolls 0)))))
(defun rpgdm--sum (roll-combo)
"Return a summation of the dice rolls in ROLL-COMBO tuple.
The tuple is a `cons'd structure where the `car' is a list of rolls,
and the `cdr' is a modifier, e.g. '((5 3 2 1 6) . 3)"
(let ((rolls (car roll-combo))
(modifier (cdr roll-combo)))
(+ (-sum rolls) modifier)))
(ert-deftest rpgdm--sum-test ()
(should (= (rpgdm--sum '((1 6) . 3)) 10))
(should (= (rpgdm--sum '((6) . -3)) 3))
(should (= (rpgdm--sum '(() . 0)) 0)))
(defun rpgdm--test-roll-series (fn args min max)
"Run function FN with ARGS to validate all results.
The numbers returned should be between MIN and MAX, with an
average value of AVG, if given."
(let ((roll-sums (->> (repeatedly fn args 1000)
(-map 'rpgdm--sum))))
;; (should (--some? (= it min) roll-sums))
;; (should (--some? (= it max) roll-sums))
(should (--every? (>= it min) roll-sums))
(should (--every? (<= it max) roll-sums))))
(ert-deftest rpgdm--roll-test ()
(let ((test-data '(((1 6) 1 6)
((3 6 4) 7 22)
((4 6 4 "-") 0 20))))
(dolist (test-seq test-data)
(destructuring-bind (dice-args lowest highest) test-seq
(rpgdm--test-roll-series 'rpgdm--roll dice-args lowest highest)))))
;; Now that we can roll a die with distinct numbers, let's now deal with dice
;; strings, e.g. 2d10+4. Can we have a regular expression that could identify
;; as well as pull apart the individual numbers?
(defvar rpgdm-roll-regexp
(rx word-start
(optional (group (one-or-more digit)))
"d"
(group (one-or-more digit))
(optional
(group (or "+" "-"))
(group (one-or-more digit)))
(optional ":"
(group (one-or-more digit)))
word-end)
"A regular expression that matches a dice roll.")
;; See: ace-jump-search-candidate (re-query-string visual-area-list)
(defun rpgdm-forward-roll (count)
"Move the point to the next COUNT of a dice roll.
Note: This moves the point to the _beginning_ of what is
considered the dice roll description, which could include any of
the following:
- d8
- 2d6
- 1d12+5
- d20-4"
(interactive "p")
(when (looking-at-p rpgdm-roll-regexp)
(re-search-forward rpgdm-roll-regexp))
(dotimes (repeat count)
(re-search-forward rpgdm-roll-regexp))
(goto-char (match-beginning 0)))
;; Practice: somed8 d4 2d8 3d6+2
(defun rpgdm--roll-expression (expression)
"Return dice roll of EXPRESSION as a string, e.g. 2d6+3."
(if (string-match rpgdm-roll-regexp expression)
(let* ((num-dice-s (or (match-string 1 expression) "1"))
(num-dice (string-to-number num-dice-s))
(dice-type-s (or (match-string 2 expression) "20"))
(dice-type (string-to-number dice-type-s))
(plus-minus (or (match-string 3 expression) "+"))
(modifier-s (or (match-string 4 expression) "0"))
(modifier (string-to-number modifier-s)))
(rpgdm--roll num-dice dice-type modifier plus-minus))
(rpgdm--roll 1 20)))
(ert-deftest rpgdm--roll-expression-test ()
(let ((test-cases '(("d6" 1 6)
("DC" 1 20)
("2d12" 2 24)
("3d6+2" 5 20))))
(dolist (test-data test-cases)
(destructuring-bind (dice-expression lowest highest) test-data
(rpgdm--test-roll-series 'rpgdm--roll-expression (list dice-expression) lowest highest)))))
(defun rpgdm--display-roll (roll-combo &optional expression)
"Convert a ROLL-COMBO.results into a suitable string.
The format for a roll combo is described with `rpgdm--sum' function.
The EXPRESSION is a string that may have generated the roll combo."
(let ((answer (rpgdm--sum roll-combo))
(die-rolls (car roll-combo))
(modifier (cdr roll-combo)))
(rpgdm--display-roll-parts answer die-rolls modifier expression)))
(defun rpgdm--display-roll-parts (answer die-rolls modifier &optional expression)
"Render parameters into a suitable string.
The ANSWER is probably the sum expression of our dice rolls,
rendered brightly. And DIE-ROLLS is a list of the die rolls.
MODIFIER is positive or negative number. The EXPRESSION is a
string that may have generated the roll combo."
(let* ((sum-str (propertize (number-to-string answer) 'face 'alert-moderate-face))
(die-str (cond ((and (= (length die-rolls) 1)
(= modifier 0)) "")
((= (length die-rolls) 1) (format " ... %d" (car die-rolls)))
(t (format " ... %s" die-rolls))))
(mod-str (cond ((> modifier 0) (format " +%d" modifier))
((< modifier 0) (format " %d" modifier))
(t "")))
(exp-str (if expression
(format " | %s" expression)
"")))
(format "%s%s%s%s" sum-str die-str mod-str exp-str)))
(ert-deftest rpgdm--display-roll-test ()
(should (equal (rpgdm--display-roll '((1 2 3) . 0)) "6 ... (1 2 3)"))
(should (equal (rpgdm--display-roll '((1 2 3) . 4)) "10 ... (1 2 3) +4"))
(should (equal (rpgdm--display-roll '((1 2 3) . -4)) "2 ... (1 2 3) -4"))
(should (equal (rpgdm--display-roll '((2) . 4)) "6 ... 2 +4"))
(should (equal (rpgdm--display-roll '((2) . 0)) "2"))
(should (equal (rpgdm--display-roll '((1 2 3) . 4) "3d6+4") "10 ... (1 2 3) +4 | 3d6+4")))
(defun rpgdm-roll (expression)
"Generate a random number based on a given dice roll EXPRESSION.
Unless the point is on a dice roll description, e.g 2d12+3."
(interactive (list (if (looking-at rpgdm-roll-regexp)
(match-string-no-properties 0)
(read-string "Dice Expression: "))))
(let ((roll-results (rpgdm--roll-expression expression)))
(message "Rolled: %s" (rpgdm--display-roll roll-results expression))))
;; ----------------------------------------------------------------------
;; ADVANTAGE and DISADVANTAGE ROLLS
;; ----------------------------------------------------------------------
(defun rpgdm--roll-with-choice (choose-fn modifier &optional plus-minus)
"Roll a d20 but choose the results based on the CHOOSE-FN function.
This is really a helper function for rolling with advantage or
disadvantage. The results are added to the MODIFIER and PLUS-MINUS,
and the entire thing is formatted with `rpgdm--display-roll-parts'."
(let* ((rolls (rpgdm--roll 2 20 modifier plus-minus))
(die-rolls (car rolls))
(modifier (cdr rolls))
(answer (+ (apply choose-fn die-rolls) modifier)))
(rpgdm--display-roll-parts answer die-rolls modifier)))
(defun rpgdm-roll-advantage (modifier &optional plus-minus)
"Roll a d20 with advantage (rolling twice taking the higher).
If looking at a dice expression, use it for MODIFIER (the
PLUS-MINUS string from the regular expression,`rpgdm-roll-regexp'),
otherwise, prompt for the modifier. Results are displayed."
(interactive (list (if (looking-at rpgdm-roll-regexp)
(match-string-no-properties 0)
(read-number "Advantage roll with modifier: "))))
(message "Rolled with Advantage: %s"
(rpgdm--roll-with-choice 'max modifier plus-minus)))
(defun rpgdm-roll-disadvantage (modifier &optional plus-minus)
"Roll a d20 with disadvantage (rolling twice taking the lower).
If looking at a dice expression, use it for MODIFIER (the
PLUS-MINUS string from the regular expression,`rpgdm-roll-regexp'),
otherwise, prompt for the modifier. Results are displayed."
(interactive (list (if (looking-at rpgdm-roll-regexp)
(match-string-no-properties 0)
(read-number "Disadvantage roll with modifier: "))))
(message "Rolled with Disadvantage: %s"
(rpgdm--roll-with-choice 'min modifier plus-minus)))
(provide 'rpgdm-dice)
;;; rpgdm-dice.el ends here

97
rpgdm-screen.el Normal file
View file

@ -0,0 +1,97 @@
;;; rpgdm-screen.el --- Support for viewing/creating a Dungeon Master's Screen -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2020 Howard X. Abrams
;;
;; Author: Howard X. Abrams <http://gitlab.com/howardabrams>
;; Maintainer: Howard X. Abrams <howard.abrams@gmail.com>
;; Created: December 15, 2020
;;
;;; Commentary:
;;
;; A collection of functions to help make a Dungeon Master Screen in Emacs.
;; This assumes functions are called in an org-formatted file.
;;
;; For instance, let's suppose most of the file is a list, and you want to
;; choose one, you can have:
;;
;; [[elisp:(rpgdm-screen-choose-list)][Choose one]]:
;;
;;; Code:
(require 'org)
(require 'org-element)
(require 's)
(defvar rpgdm-screen-last-results ""
"The results from calls to `rpgdm-screen-' functions are stored here.")
(defun rpgdm-screen-last-results ()
"Display results from the last call to a `rpgdm-screen-' function."
(interactive)
(message rpgdm-screen-last-results))
(defun rpgdm-screen--get-list-items ()
"Return a list of all the list items in the org document."
(org-element-map (org-element-parse-buffer) 'item
(lambda (item)
(buffer-substring-no-properties
(org-element-property :contents-begin item)
(org-element-property :contents-end item)))))
(defun rpgdm-screen-choose-list ()
"Randomly choose an elemeent from all lists in the current file.
The contents of the item is displayed in the mini-buffer."
(interactive)
(let* ((items (rpgdm-screen--get-list-items))
(item (nth (random (length items)) items)))
(setq rpgdm-screen-last-results (s-trim item))
(message rpgdm-screen-last-results)))
(defun rpgdm-screen-choose-sublist ()
"Randomly choose an elemeent from the lists in the subtree.
The contents of the item is displayed in the mini-buffer."
(interactive)
(save-excursion
(org-narrow-to-subtree)
(rpgdm-screen-choose-list)
(widen)))
(defun rpgdm-screen ()
(interactive)
(delete-other-windows)
;; Start the Right Side with DIRED
(split-window-right)
(other-window 1)
(dired "dnd-5e")
(dired-hide-details-mode)
(split-window-right)
(find-file "skill-checks.org")
(split-window-below)
(split-window-below)
(other-window 1)
(find-file "names.org")
(other-window 1)
(find-file "magic-schools.org")
(split-window-below)
(other-window 1)
(find-file "costs.org")
(other-window 1)
;; On the far right window:
(split-window-below)
(split-window-below)
(other-window 1)
(find-file "gear.org")
(other-window 1)
(find-file "trinkets.org")
(split-window-below)
(other-window 1)
(find-file "conditions.org")
(other-window 1)
)
(provide 'rpgdm-screen)
;;; rpgdm-screen.el ends here

363
rpgdm-tables.el Normal file
View file

@ -0,0 +1,363 @@
;;; rpgdm-tables.el --- Choose table from Tables -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2021 Howard X. Abrams
;;
;; Author: Howard X. Abrams <http://gitlab.com/howardabrams>
;; Maintainer: Howard X. Abrams <howard.abrams@workday.com>
;; Created: January 8, 2021
;;
;; This file is not part of GNU Emacs.
;;
;;; Commentary:
;;
;; By storing tables in files, we can preparse them, allowing us to randomly
;; choose entries. The primary interface are:
;;
;; - `rpgdm-tables-load' :: Which when pointed to a directory, stores the data
;; in all text files read.
;;
;; - `rpgdm-tables-choose' :: Which, when a table is choosen, returns a random
;; element.
;;
;; The files read can be simply formatted as lists, or as an org-mode table. If
;; a table is found, the second column should be a _frequency_ label, where some
;; items in that table will be chosen more often than others.
;;
;;; Code:
(defvar rpgdm-base ".")
(require 'rpgdm-dice (expand-file-name "rpgdm-dice.el" rpgdm-base) t)
(defvar rpgdm-tables-directory
(expand-file-name "tables" rpgdm-base)
"Directory path containing the tables to load and create functions.")
(defvar rpgdm-tables (make-hash-table :test 'equal)
"Collection of tables and lists for the Dungeon Master.")
(defun rpgdm-tables-load (&optional filepath)
"Create functions from table files located in FILEPATH directory."
(interactive (list (read-directory-name "DM Tables Directory: " rpgdm-tables-directory)))
(dolist (table-file (directory-files filepath t))
(let ((name (file-name-base table-file))
(contents (rpgdm-tables--read-table-file table-file)))
;; (message "Read: %s" table-file)
(puthash name contents rpgdm-tables)))
(message "Read: %s" (s-join ", " (hash-table-keys rpgdm-tables))))
(defun rpgdm-tables-choose (table-name)
"Given a TABLE-NAME string, pick a random item from that table."
(interactive (list (completing-read "Choose from Table: " (hash-table-keys rpgdm-tables))))
(let ((table (gethash table-name rpgdm-tables)))
(cond ((listp table) (rpgdm-tables--choose-list table))
((hash-table-p table) (rpgdm-tables--choose-hash table))
(t "Error: Could choose anything from %s (internal bug?)" table-name))))
(defvar rpgdm-tables--line-parse
(rx bol (zero-or-more space)
(optional
(any "+" "-" "*" "|")
(one-or-more space))
(group (+? any))
(optional (zero-or-more space) (or ":" "|") (zero-or-more space)
(group (one-or-more alphanumeric))
(zero-or-more space) (optional (or ":" "|")) (zero-or-more space))
eol)
"A regular expression for locating parsable lines.")
(ert-deftest rpgdm-tables--line-parse-test ()
"Why yes, we should test our regular expression."
(dolist (data '((" - normal list" "normal list" nil)
(" + normal list" "normal list" nil)
(" * normal list" "normal list" nil)
("normal list" "normal list" nil)
(" - list with tag :tag:" "list with tag" "tag")
(" - list with tag :tag" "list with tag" "tag")
(" - list with tag : tag" "list with tag" "tag")
(" | table cell | freq |" "table cell" "freq")))
(cl-destructuring-bind (line contents tag) data
(should (string-match rpgdm-tables--line-parse line))
(should (equal (match-string 1 line) contents))
(when tag
(should (equal (match-string 2 line) tag))))))
(defun rpgdm-tables--read-table-file (table-file)
"Read and parse TABLE-FILE as data. Whatever that means."
(with-temp-buffer
(insert-file-contents table-file)
(goto-char (point-min))
(flush-lines (rx bol (zero-or-more space) "#"))
(when (re-search-forward rpgdm-tables--line-parse nil nil)
(if (match-string 2)
(rpgdm-tables--parse-as-hash)
(rpgdm-tables--parse-as-list)))))
(defun rpgdm-tables--parse-as-list ()
"Return list of lines matching `rpgdm-tables--line-parse'."
(let ((results (list (match-string-no-properties 1))))
(while (re-search-forward rpgdm-tables--line-parse nil t)
(let ((entry (match-string-no-properties 1)))
(setq results (cons entry results))))
results))
(defun rpgdm-tables--parse-as-hash ()
"Return hashtable of lines matching `rpgdm-tables--line-parse'.
The keys in the hashtable are the tags from the file, and the
values will be a list of matching entries of that tag.
For instance, the file:
- salt :common:
- silver :rare:
- gold :rare:
- pepper :common:
Would return a hashtable containing:
rare: [gold silver]
common [salt peper]"
;; Create a hash, populated it, and return it:
(let ((results (make-hash-table :test 'equal))
(entry (match-string-no-properties 1))
(tag (match-string-no-properties 2)))
;; Store initial match from parent call:
(puthash tag (list entry) results)
(while (re-search-forward rpgdm-tables--line-parse nil t)
(let* ((entry (match-string-no-properties 1))
(tag (match-string-no-properties 2))
(prev-list (gethash tag results)))
(puthash tag (cons entry prev-list) results)))
;; Combine the sublists of equivalent tags:
(rpgdm-tables--flatten-hash results)))
(defun rpgdm-tables--flatten-hash (table)
"Combine the values of equivalent table-tags in TABLE.
A table, read as a hash table, may have similar, but equal tags.
For instance, `veryrare' and `very-rare' are the same."
(let* ((table-tags (rpgdm-tables--which-tag-group table)) ; Ignore all the numbers
(tags (-map 'rest table-tags)))
(dolist (subtag-list tags)
(unless (= 1 (length subtag-list))
(let ((keeper (first subtag-list)))
(dolist (tag (rest subtag-list))
(puthash keeper (append (gethash keeper table)
(gethash tag table)) table)
(remhash tag table)))))
table))
;; ----------------------------------------------------------------------
;;
;; At this point, we have a hash table of tables, where the key is the name, and
;; the value is either:
;; - A list of things to choose
;; - A hash table where the key is a tag, and the value is a list of items
;; that match that tag.
;;
;; Obviously, selecting an element from a list is easy:
(defun rpgdm-tables--choose-list (lst)
"Randomly choose (equal chance for any) element in LST."
(let ((item (seq-random-elt lst)))
(message "%s" item)))
;; However, choosing an element in a hash of tags seems ... challenging. This is
;; because I want the tags to somehow add a particular weight to the randomness.
;; Not a complete standard distribution (bell curve), but a little more favor to
;; some items. For instance, labeling something 'common' should show more often
;; than 'uncommon'.
;;
;; Choosing an item from a hash table is a complicated algorithm that may not be
;; as obvious by reading the code, so let's describe this with an example.
;; Assume we have the following frequency table with a /relative weight/ for each tag:
;;
;; - often :: 4
;; - seldom :: 3
;; - scarely :: 2
;; - rarely :: 1
;;
;; Is coded with the following list of lists:
;;
;; ((4 "often")
;; (3 "seldom" "sometimes")
;; (2 "scarcely" "scarce" "hardly ever")
;; (1 "rarely"))
;;
;; Read this as: we should have 4 times as many items labeled "often" as "rarely".
;;
;; So we use the function, `rpgdm-tables--table-distribution' to make a
;; table-specific tag list, usually called `table-tags', where:
;;
;; each weight = the number of items * relative weight
;;
;; So if we had 11 items in the table tagged as "often", and 8 rare
;; items, we would have a tag table as:
;;
;; ((44 "often") (27 "seldom") (22 "scarcely") (8 "rarely"))
;; TODO English tags and their relative weights are hard-coded at the moment.
;; This really should just be part of the file, perhaps as a buffer-local
;; variable?
(defconst rpgdm-tables-tag-groups
'(((10 "common")
(6 "uncommon")
(4 "rare")
(2 "veryrare" "very-rare" "very rare")
(1 "legendary"))
((4 "often")
(3 "seldom" "sometimes")
(2 "scarcely" "scarce" "hardly ever")
(1 "rarely"))))
(defun rpgdm-tables--choose-hash (table)
"Select item from a hash TABLE.
Note that tables stored in a hash table have weight keys and a list
of items associated with that weight."
(let* ((table-tags (rpgdm-tables--table-distribution table))
(tag (rpgdm-tables--choose-tag table-tags)))
(rpgdm-tables--choose-list (gethash tag table))))
(defun rpgdm-tables--relevel-table (table tag)
"Given a TAG of a hash TABLE, return new relative level.
The new value is based on the original weight, e.g. 4 and the
number of items of that particular tag.
Note: This is a helper function for `rpgdm-tables--table-distribution'."
(let* ((name (second tag))
(items (gethash name table))
(weight (first tag))
(new-weight (* weight (length items))))
(list new-weight name)))
(ert-deftest rpgdm-tables-relevel-table-test ()
;; Need to make a fake table, so we will just have a single entry in this
;; table, with a tag of "often". We'll specify that the weight for this should
;; be 4, and we'll store 10 items under that tag:
(let* ((table (make-hash-table :test 'equal))
(tag "often")
(tag-weight-tuple (list 4 tag)))
(puthash tag (number-sequence 1 10) table)
(should (equal (list 40 tag)
(rpgdm-tables--relevel-table table tag-weight-tuple)))))
(defun rpgdm-tables--table-distribution (table)
"Return a relative frequency tag group for a given TABLE.
Works by running map over the table's tags through the
`rpgdm-tables--relevel-table' helper function."
(let ((table-tags (rpgdm-tables--which-tag-group table)))
(--map (rpgdm-tables--relevel-table table it) table-tags)))
(defun rpgdm-tables--sum-tag-weights (tags)
"The TAGS is a list of lists where the first element is a numeric weight.
Using `-reduce' allows us to sum these, but we need to make sure that the
first element of our list is our initial condition, so we `cons' a 0 onto
the start."
(--reduce (+ acc (first it)) (cons 0 tags)))
(ert-deftest rpgdm-tables--sum--tag-weights-test ()
(let ((weighted-tags
'((44 "often") (27 "seldom") (22 "scarcely") (7 "rarely"))))
(should (= 100 (rpgdm-tables--sum-tag-weights weighted-tags)))))
(defun rpgdm-tables--find-tag (roll tag-list)
"Given a ROLL as a level in TAG-LIST, return matching tag.
The matching is based on the weight. A million ways to do this,
but stepping through the list of tags to see roll is in that
*window*, and if not, both move to the next tag, as well as
decrement the ROLL value."
(cl-loop for (num-elems tag) in tag-list do
;; (message "Comparing %d <= %d for %s" roll num-elems tag)
(if (<= roll num-elems)
(return tag)
(decf roll num-elems))))
(ert-deftest rpgdm-tables--find-tag-test ()
(let ((weighted-tags
'((44 "often") (27 "seldom") (22 "scarcely") (7 "rarely"))))
(should (equal "often" (rpgdm-tables--find-tag 1 weighted-tags)))
(should (equal "often" (rpgdm-tables--find-tag 44 weighted-tags)))
(should (equal "seldom" (rpgdm-tables--find-tag 45 weighted-tags)))
(should (equal "seldom" (rpgdm-tables--find-tag 71 weighted-tags)))
(should (equal "scarcely" (rpgdm-tables--find-tag 72 weighted-tags)))
(should (equal "scarcely" (rpgdm-tables--find-tag 93 weighted-tags)))
(should (equal "rarely" (rpgdm-tables--find-tag 94 weighted-tags)))
(should (equal "rarely" (rpgdm-tables--find-tag 100 weighted-tags)))))
(defun rpgdm-tables--choose-tag (tags)
"Select random tag from TAGS in `rpgdm-tables-tag-groups'.
Uses helper function, `rpgdm-tables--find-tag'."
(let* ((upper-limit (rpgdm-tables--sum-tag-weights tags))
(roll (rpgdm--roll-die upper-limit)))
;; (message "Rolled %d on %d" roll upper-limit)
(rpgdm-tables--find-tag roll tags)))
(defun rpgdm-tables--which-tag-group (table)
"Return the tag table-tags associated with TABLE."
(let (results
(tag (first (hash-table-keys table))))
(dolist (table-tags rpgdm-tables-tag-groups results)
(let ((tag-list (->> table-tags
(-map 'rest) ; Drop the numeric weight from each sublist
(-flatten))))
(when (-contains? tag-list tag)
(setq results table-tags))))))
;; ----------------------------------------------------------------------
;; Let's attempt to test our code and its theories.
;;
;; The function repeatedly selects items from a table randomly,
;; and returns a hash of the number of times each element was
;; selected ...
(defun rpgdm-tables-validate (&optional table-name iterations)
"Return results randomly choosing many items from TABLE-NAME.
Calls `rpgdm-tables-choose' a number of ITERATIONS (defaults to 500)."
(unless iterations (setq iterations 500))
(unless table-name
(setq table-name "test-subject")
(puthash table-name (make-hash-table :test 'equal) rpgdm-tables)
(setf (gethash "often" (gethash table-name rpgdm-tables))
'(o1 o2 o3 o4 o5 o6 o7 o8 o9 o0))
(setf (gethash "seldom" (gethash table-name rpgdm-tables))
'(s1 s2 s3 s4 s5 s6 s7 s8 s9 s0))
(setf (gethash "scarcely" (gethash table-name rpgdm-tables))
'(l1 l2 l3 l4 l5 l6 l7 l8 l9 l0))
(setf (gethash "rarely" (gethash table-name rpgdm-tables))
'(r1 r2 r3 r4 r5 r6 r7 r8 r9 r0)))
(let ((accumulator (make-hash-table :test 'equal)))
(dotimes (i iterations accumulator)
(let* ((item (rpgdm-tables-choose table-name))
(item-name (first (s-split " :: " item))))
(incf (gethash item-name accumulator 0))))
accumulator))
;; Since we are randomly selecting items, even over large iterations, one can
;; see _scarcely_ appear almost as much as items labeled _often_. However, if we
;; first sort the data:
;;
;; "o1" 35 "o2" 31 "o3" 38 "o4" 44 "o5" 43 ...
;; "s1" 35 "s2" 38 "s3" 29 "s4" 28 "s5" 26 ...
;; "l1" 26 "l2" 20 "l3" 19 "l4" 19 "l5" 26 ...
;; "r1" 10 "r2" 7 "r3" 8 "r4" 5 "r5" 13 ...
;;
;; And then calculate the average of each _level_, we see that the items occur
;; as we would expect:
;;
;; (/ (+ 35 31 38 44 43) 5) -> 38
;; (/ (+ 35 38 29 28 26) 5) -> 31
;; (/ (+ 26 20 19 19 26) 5) -> 22
;; (/ (+ 10 7 8 5 13) 5) -> 8
(provide 'rpgdm-tables)
;;; rpgdm-tables.el ends here

183
rpgdm.el Normal file
View file

@ -0,0 +1,183 @@
;;; rpgdm.el --- Support utilities for the RPG Game Master -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2021 Howard X. Abrams
;;
;; Author: Howard X. Abrams <http://gitlab.com/howardabrams>
;; Maintainer: Howard X. Abrams <howard.abrams@workday.com>
;; Created: January 4, 2021
;;
;; This file is not part of GNU Emacs.
;;
;;; Commentary:
;;
;; This package includes all the help and support I can think for the Game
;; Master running a role-playing game.
;;
;; This include a minor mode, `rpgdm' that adds a few keybindings useful
;; with either org-mode or markdown-formatted files.
;;
;;; Code:
(defconst rpgdm-base (file-name-directory load-file-name))
(load-file (expand-file-name "rpgdm-dice.el" rpgdm-base))
(load-file (expand-file-name "rpgdm-screen.el" rpgdm-base))
(load-file (expand-file-name "rpgdm-tables.el" rpgdm-base))
(defgroup rpgdm nil
"Customization for the Dungeon Master support package."
:prefix "rpgdm-"
:group 'applications
:link '(url-link :tag "Github" "https://gitlab.com/howardabrams/emacs-rpgdm"))
(defun rpgdm-yes-and-50/50 ()
"Add spice to your 50/50 events (luck) with Yes/No+complications.
The Freeform Universal RPG has the idea that you could succeed or
fail, but have extra complications or extra bonuses. This returns
one of six answers with equal frequency:
- No, and ... in other words, no luck, plus a minor complication.
- No. ... Nope, no luck at this time.
- No, but ... in other words, no luck, but something else good.
- Yes, but ... you got what you wanted, but with a complication.
- Yes. ... Yup, luck is on your side.
- Yes, and ... Yes, plus you get a little something-something.
https://www.drivethrurpg.com/product/89534/FU-The-Freeform-Universal-RPG-Classic-rules"
(interactive)
(let (rolled (rpgdm--roll-die 6))
(cond ((= rolled 1) "No, and... (fails badly that you add a complication)")
((= rolled 2) "No.")
((= rolled 3) "No, but... (fails, but add a little bonus or consolation prize)")
((= rolled 4) "Yes, but... (succeeds, but add a complication or caveat)")
((= rolled 5) "Yes.")
(t "Yes, and... (succeeds, plus add a litle extra something-something)"))))
;; ----------------------------------------------------------------------
;; SKILL CHECKS
;; ----------------------------------------------------------------------
;; I would like to have a function that
(defun rpgdm--skill-level-dice (number-of-dice)
"Return a random skill challenge level.
The formula is based on the NUMBER-OF-DICE. According to the
Players Handbook in Dungeons and Dragons, we have this table
to determine difficulty skill check levels:
- Very easy 5
- Easy 10
- Medium 15
- Hard 20
- Very hard 25
- Nearly impossible 30
But I read somewhere that you could roll some 6 sided die to help
add a bit of randomness to the leve setting. Essentially, roll
the 6d and add 7.
Easy -- Die: 1 Lowest: 8 Highest: 13 Average: 10
Medium -- Die: 2 Lowest: 9 Highest: 19 Average: 14
Hard -- Die: 3 Lowest: 10 Highest: 25 Average: 17
Very hard -- Die: 4 Lowest: 11 Highest: 30 Average: 20
Nearly Impossible -- Die: 5 Lowest: 14 Highest: 35 Average: 24"
(rpgdm--sum
(rpgdm--roll number-of-dice 6 7)))
;; Let's verify my assumptions:
;; (dolist (die '(0 1 2 3 4 5))
;; (let* ((rolls (repeatedly 'rpgdm--skill-level-dice (list die) 1000))
;; (highest (apply 'max rolls))
;; (lowest (apply 'min rolls))
;; (average (/ (-sum rolls) 1000)))
;; (message
;; (format "Die: %d Lowest: %d Highest: %d Average: %d\n" die lowest highest average))))
(defun rpgdm--skill-level (target)
"Return a skill challenge level by Interpreting TARGET.
This parameter can be a symbol or string for 'easy', 'hard', etc.
Or it can be an actual number."
(when (symbolp target)
(setq target (symbol-name target)))
(cond ((string-prefix-p target "trivial" t) 5)
((string-prefix-p target "easy" t) (rpgdm--skill-level-dice 1))
((string-prefix-p target "moderate" t) (rpgdm--skill-level-dice 2))
((string-prefix-p target "medium" t) (rpgdm--skill-level-dice 2))
((string-prefix-p target "hard" t) (rpgdm--skill-level-dice 3))
((string-prefix-p target "difficult" t) (rpgdm--skill-level-dice 4))
((string-prefix-p target "very hard" t) (rpgdm--skill-level-dice 4))
((string-prefix-p target "impossible" t) (rpgdm--skill-level-dice 5))
((numberp target) target)
(t (max (string-to-number target) 12))))
(defun rpgdm--yes-and (target rolled-results)
"Instead of returning a pass/fail, return 'Yes, but' strings.
The Freeform Universal RPG has the idea that you could succeed or
fail, but have extra complications or extra bonuses based on how
high/low you pass/fail. I have expanded the idea with a d20, so
given a TARGET number, like '12', and the ROLLED-RESULTS from the
player, this returns a string based on a table.
https://www.drivethrurpg.com/product/89534/FU-The-Freeform-Universal-RPG-Classic-rules"
(cond ((< rolled-results (- target 7)) "No, and... !!")
((< rolled-results (- target 3)) "No.")
((< rolled-results target) "No, but...")
((< rolled-results (+ target 3)) "Yes, but...")
((< rolled-results (+ target 7)) "Yes.")
(t "Yes, and... !!")))
(ert-deftest rpgdm--yes-and-test ()
(should (equal (rpgdm--yes-and 10 1) "No, and..."))
(should (equal (rpgdm--yes-and 10 2) "No, and..."))
(should (equal (rpgdm--yes-and 10 3) "No."))
(should (equal (rpgdm--yes-and 10 4) "No."))
(should (equal (rpgdm--yes-and 10 5) "No."))
(should (equal (rpgdm--yes-and 10 6) "No."))
(should (equal (rpgdm--yes-and 10 7) "No, but..."))
(should (equal (rpgdm--yes-and 10 8) "No, but..."))
(should (equal (rpgdm--yes-and 10 9) "No, but..."))
(should (equal (rpgdm--yes-and 10 10) "Yes, but..."))
(should (equal (rpgdm--yes-and 10 11) "Yes, but..."))
(should (equal (rpgdm--yes-and 10 12) "Yes, but..."))
(should (equal (rpgdm--yes-and 10 13) "Yes."))
(should (equal (rpgdm--yes-and 10 14) "Yes."))
(should (equal (rpgdm--yes-and 10 15) "Yes."))
(should (equal (rpgdm--yes-and 10 16) "Yes."))
(should (equal (rpgdm--yes-and 10 17) "Yes, and...")))
(defun rpgdm-skill-check (target rolled-results)
"Given a TARGET skill check, and ROLLED-RESULTS, return pass/fail.
The string can return a bit of complications, from `rpgdm--yes-and'."
(interactive (list (completing-read "Target Level: "
'(Trivial Easy Moderate Hard Difficult Impossible))
(read-number "Rolled Results: ")))
(message (rpgdm--yes-and target rolled-results)))
(defun rpgdm-skill-check-easy (rolled-results)
"Return an embellished pass/fail from ROLLED-RESULTS for an easy skill check."
(interactive "nRolled Results: ")
(rpgdm-skill-check (rpgdm--skill-level 'easy) rolled-results))
(defun rpgdm-skill-check-moderate (rolled-results)
"Return an embellished pass/fail from ROLLED-RESULTS for a moderately-difficult skill check."
(interactive "nRolled Results: ")
(rpgdm-skill-check (rpgdm--skill-level 'medium) rolled-results))
(defun rpgdm-skill-check-hard (rolled-results)
"Return an embellished pass/fail from ROLLED-RESULTS for a hard skill check."
(interactive "nRolled Results: ")
(rpgdm-skill-check (rpgdm--skill-level 'hard) rolled-results))
(defun rpgdm-skill-check-difficult (rolled-results)
"Return an embellished pass/fail from ROLLED-RESULTS for a difficult skill check."
(interactive "nRolled Results: ")
(rpgdm-skill-check (rpgdm--skill-level 'difficult) rolled-results))
(defun rpgdm-skill-check-impossible (rolled-results)
"Return an embellished pass/fail from ROLLED-RESULTS for an almost impossible skill check."
(interactive "nRolled Results: ")
(rpgdm-skill-check (rpgdm--skill-level 'impossible) rolled-results))
(provide 'rpgdm)
;;; rpgdm.el ends here