├── LICENSE ├── README.md ├── damage-roller.lisp ├── hp-roller.lisp ├── package.lisp ├── read-org-tables.lisp ├── simple-maps.lisp ├── tables ├── README-LICENSE ├── crits.org ├── fumble.org └── monsters.org ├── tasks-attacks-roller.lisp ├── whiteshell.asd └── whiteshell.lisp /LICENSE: -------------------------------------------------------------------------------- 1 | The code is MIT License. Any Whitehack content is standard copyright of Whitehack's author Christian Mehrstam, all rights reserved. 2 | 3 | MIT License 4 | 5 | Copyright (c) 2023 whitehackrpg 6 | 7 | Permission is hereby granted, free of charge, to any person obtaining a copy 8 | of this software and associated documentation files (the "Software"), to deal 9 | in the Software without restriction, including without limitation the rights 10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 11 | copies of the Software, and to permit persons to whom the Software is 12 | furnished to do so, subject to the following conditions: 13 | 14 | The above copyright notice and this permission notice shall be included in all 15 | copies or substantial portions of the Software. 16 | 17 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 18 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 19 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 20 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 21 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 23 | SOFTWARE. 24 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # whiteshell 2 | A repository for a shell with [Whitehack RPG](https://whitehackrpg.wordpress.com/) tools. 3 | 4 | Clone the repository and softlink it in your quicklisp/local-projects directory. Then: 5 | 6 | ``` 7 | (ql:quickload :whiteshell) 8 | (in-package :whiteshell) 9 | ``` 10 | 11 | Now you can use the functions in the REPL: 12 | 13 | https://github.com/whitehackrpg/whiteshell/assets/130791778/6c9208e2-7df9-430f-a4e2-369d53103685 14 | 15 | In the above video, Whiteshell runs from an advanced SLIME repl in Emacs. That isn't necessary. You can just as well simply install sbcl (http://sbcl.org/) and quicklisp (https://www.quicklisp.org/beta/) and then use `rlwrap` to run Whiteshell comfortably in your regular shell: 16 | 17 | ``` 18 | rlwrap sbcl 19 | ; In sbcl: 20 | (ql:quickload :whiteshell) 21 | (in-package :whiteshell) 22 | (whiteshell) 23 | ``` 24 | Alternatively, make a simple script to use via bash from the command line. For example: 25 | 26 | 1. Install sbcl somewhere (default /usr/local). 27 | 2. Put a tool file where you want it (like in your $HOME). 28 | 3. Make a bash-script like the below example: 29 | 30 | ``` 31 | #!/usr/local/bin/sbcl --script 32 | 33 | (setf *random-state* (make-random-state t)) 34 | (load "/home/your-user/simple-maps.lisp") 35 | (print-map) 36 | ``` 37 | 38 | Then make the script executable and run it: 39 | 40 | ``` 41 | chmod +x yourscript.lisp 42 | ./yourscript.lisp 43 | ``` 44 | In this case it will give you something like: 45 | 46 | ``` 47 | ######## 48 | #......# ####### 49 | #......############## #.....# 50 | ###### ########################...................#######.....# 51 | #....# #......................................................# 52 | #....########.########################################.#########.### 53 | #................................# ###########.##### #.# 54 | #....########.##########.....#...# #......##.......# #.# 55 | ###.## #.......# #.....#...# #......##.......#####.#### 56 | #.# #.......####.........###### #........................### 57 | ###### #.# #.........................# #......##.......####.......# 58 | #....# #.# ####.......######.......####.#########.####.......####.......# 59 | #....######.######......#.....................................................# 60 | #............................#########..........#####...######.#.######.......# 61 | ###.............................................# #...######.#.# ######### 62 | ################......#############################............# 63 | #......................................###......# 64 | #......#############################............# 65 | #......# #######......# 66 | ######## ######## 67 | ``` 68 | A third alternative is to generate a stand-alone executable. Launch sbcl and do: 69 | 70 | * `(ql:quickload :whiteshell)` 71 | * `(sb-ext:save-lisp-and-die #p"name-of-executable" :toplevel #'whiteshell:bot :executable t)` 72 | 73 | Once an executable has been generated, you can call it like so: `./name-of-executable whiteshell::command arg1 arg2 etc` 74 | -------------------------------------------------------------------------------- /damage-roller.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Whiteshell damage and crit roller 2 | 3 | (in-package #:whiteshell) 4 | 5 | (defparameter *crittable* (asdf:system-relative-pathname "whiteshell" "tables/crits.org")) 6 | 7 | (defparameter *fumbletable* (asdf:system-relative-pathname "whiteshell" "tables/fumble.org")) 8 | 9 | (defun consequences (value type) 10 | (let* ((d6 (nd6 1)) 11 | (d10 (1+ (random 10))) 12 | (d3 (ceiling (nd6 1) 2))) 13 | (flet ((results (value type &optional (factor 1)) 14 | (format nil "~a ~a d6: ~a d10: ~a d3: ~a" 15 | value type (* d6 factor) (* d10 factor) 16 | (* d3 factor)))) 17 | (case type 18 | (failure (format nil "~a Miss!" value)) 19 | (plink (format nil "~a Plink!" value)) 20 | (success (results value type)) 21 | (crit (format nil "~a~%~a" (results value type 2) (crit d6 d10))) 22 | (fumble (format nil "~a ~a~%~a" value type 23 | (crit-fumble-effects d6 *fumbletable*))))))) 24 | 25 | (defun crit-fumble-effects (n table) 26 | (format nil "~{~a~^ ~}" (locate-entry (write-to-string n) 27 | (read-org-table table)))) 28 | 29 | (defun crit (d6 d10) 30 | (let ((caused6 (when (<= d6 2) 31 | (format nil "Table roll due to: d6(~a) ~%" d6))) 32 | (caused10 (when (<= d10 2) 33 | (format nil "Table roll due to: d10(~a) ~%" d10)))) 34 | (if (or caused6 caused10) 35 | (format nil "~a~a~a" (or caused6 "") (or caused10 "") 36 | (crit-fumble-effects (1+ (random 20)) *crittable*)) 37 | (format nil "No table roll.")))) 38 | 39 | -------------------------------------------------------------------------------- /hp-roller.lisp: -------------------------------------------------------------------------------- 1 | ;;;; hp-roller. The class-hp list and class case names are built from hard-coded 2 | ;;;; Whitehack content, pp. 32, 81, 83, 84. 3 | 4 | (in-package #:whiteshell) 5 | 6 | (defun d6 (&optional print) 7 | (let ((result (1+ (random 6)))) 8 | (when print (print result)) 9 | result)) 10 | 11 | (defun nd6 (n &optional (mod 0) print) 12 | (if (zerop n) 13 | 0 14 | (+ mod (d6 print) (nd6 (1- n) 0 print)))) 15 | 16 | (let ((class-hp '((1 2 (2 . 1) 3 (3 . 1) 4 (4 . 1) 5 (5 . 1) 6) 17 | ((1 . 2) 2 3 4 5 6 7 8 9 10) 18 | ((1 . 1) 2 (2 . 1) 3 4 (4 . 1) 5 6 (6 . 1) 7) 19 | (#C(1 2) #C(2 2) #C(3 2) 4 5 6 7 8 9 10)))) 20 | 21 | (defun hp-roller (class level &optional print) 22 | (let ((hp-list (cond ((equalp (write-to-string class) "strong") 1) 23 | ((equalp (write-to-string class) "wise") 2) 24 | ((equalp (write-to-string class) "brave") 3) 25 | (t 0)))) 26 | (if (zerop level) 27 | 0 28 | (let ((thisroll (nth (1- level) (nth hp-list class-hp)))) 29 | (max (cond ((consp thisroll) 30 | (nd6 (car thisroll) (cdr thisroll) print)) 31 | ((complexp thisroll) 32 | (max (nd6 (realpart thisroll) 0 print) 33 | (nd6 (realpart thisroll) 0 print))) 34 | (t (nd6 thisroll 0 print))) 35 | (hp-roller class (1- level) print))))))) 36 | 37 | (defun average-hp (class level &optional (times 1000)) 38 | (average (hp-roller class level) times)) 39 | 40 | -------------------------------------------------------------------------------- /package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; package.lisp 2 | 3 | (defpackage #:whiteshell 4 | (:use #:cl) 5 | (:export :bot)) 6 | 7 | -------------------------------------------------------------------------------- /read-org-tables.lisp: -------------------------------------------------------------------------------- 1 | ;;;; read-org-tables 2 | 3 | (in-package #:whiteshell) 4 | 5 | (defun strip-from-string (string &rest things) 6 | (do* ((thing (pop things) (pop things)) 7 | (result (remove thing string :test #'equal) 8 | (remove thing result :test #'equal))) 9 | ((null things) result) 10 | ())) 11 | 12 | (defun locate-entry (entry list) 13 | (find-if #'(lambda (n) (equalp entry (car n))) list)) 14 | 15 | (defun read-org-table (file) 16 | (mapcar #'(lambda (line) (remove-if #'(lambda (n) 17 | (equal n "")) 18 | (uiop:split-string 19 | (strip-from-string line #\|)))) 20 | (uiop:read-file-lines file))) 21 | 22 | (defparameter *monstertable* (cddr (read-org-table (asdf:system-relative-pathname "whiteshell" "tables/monsters.org")))) 23 | 24 | 25 | 26 | (defun monster (entry &optional (list *monstertable*)) 27 | (let* ((themob (locate-entry (write-to-string entry) list)) 28 | (name (car themob)) (hd (handle-hd (cadr themob))) (df (caddr themob)) 29 | (mv (cadddr themob)) (lt (nth 4 themob)) 30 | (spec (format nil "~{~a~^ ~}" (nthcdr 5 themob)))) 31 | (format nil "~A HD: ~A HP: ~A DF: ~A MV: ~A LT: ~A Special: ~A" 32 | name 33 | hd 34 | (hd-to-hp hd) 35 | df 36 | mv 37 | lt 38 | spec))) 39 | 40 | (defun handle-hd (string) 41 | (if (and (>= (length string) 4) (string= (subseq string 1 2) "-")) 42 | (let ((firstnum (read-from-string (subseq string 0 1))) 43 | (secnum (read-from-string (subseq string 3)))) 44 | (format nil "~a" (+ firstnum (random (1+ (- secnum firstnum)))))) 45 | string)) 46 | 47 | (defun hd-to-hp (string) 48 | (cond ((string= string "1*") "1") 49 | ((<= (length string) 2) (nd6 (read-from-string string))) 50 | ((string= (subseq string 1 2) "+") 51 | (format nil "~a" (+ (nd6 (read-from-string (subseq string 0 1))) 52 | (read-from-string (subseq string 2))))))) 53 | 54 | 55 | -------------------------------------------------------------------------------- /simple-maps.lisp: -------------------------------------------------------------------------------- 1 | ;;;; print-map prints a simple, random map structure that you can populate with stuff yourself. 2 | 3 | (in-package #:whiteshell) 4 | 5 | (defparameter *surr* (list #C( 0 -1) #C(0 1) #C(-1 0) #C(1 0) 6 | #C(-1 -1) #C(1 -1) #C(-1 1) #C(1 1)) 7 | "Complex modifiers to get the coords around a coord.") 8 | 9 | (defun within (a b c) 10 | "Is a within b and c?" 11 | (and (>= a b) 12 | (<= a c))) 13 | 14 | (defun toward (x y) 15 | "Return next value going from x to y." 16 | (cond ((= x y) x) 17 | ((< x y) (1+ x)) 18 | (t (1- x)))) 19 | 20 | (defun mkmap (xdim ydim &aux (map (make-hash-table))) 21 | "Return a basic roguelike map in a hash-table." 22 | (dotimes (x xdim) 23 | (dotimes (y ydim) 24 | (setf (gethash (complex x y) map) #\#))) 25 | (genrooms xdim ydim map (complex (round xdim 2) (round ydim 2)) nil 26 | (floor (* xdim ydim) 50))) 27 | 28 | (defun leg (a end-a b map &optional v) 29 | "Make a leg in a corridor -- give a fifth arg for a vertical leg." 30 | (unless (= a end-a) 31 | (setf (gethash (complex (if v b a) (if v a b)) map) #\.) 32 | (leg (toward a end-a) end-a b map v))) 33 | 34 | (defun make-corridor (nc lc map) 35 | "Make a corridor between two rooms." 36 | (destructuring-bind (nx lx ny ly) (list (realpart nc) (realpart lc) 37 | (imagpart nc) (imagpart lc)) 38 | (case (random 2) 39 | (0 (leg nx lx ny map) (leg ny ly lx map 'vert)) 40 | (t (leg ny ly lx map 'vert) (leg nx lx ny map))))) 41 | 42 | (defun o-o-bounds (xdim ydim cx cy width height) 43 | "Check if room is out of bounds." 44 | (dotimes (w width) 45 | (dotimes (h height) 46 | (unless (and (within (+ w cx) 1 (- xdim 2)) 47 | (within (+ h cy) 1 (- ydim 2))) 48 | (return-from o-o-bounds t))))) 49 | 50 | (defun genrooms (xdim ydim map old-cent room-list count) 51 | "Generate the rooms of a level." 52 | (let* ((w (+ 3 (random 6))) ; width 53 | (h (+ 3 (random 6))) ; height 54 | (cx (random xdim)) ; corner-x 55 | (cy (random ydim)) ; corner-y 56 | (new-cent (complex (+ cx (round w 2)) (+ cy (round h 2))))) 57 | (cond ((zerop count) map) 58 | ((and (not (o-o-bounds xdim ydim cx cy w h)) 59 | (null (intersection (rcoords w h cx cy) room-list))) 60 | (dotimes (x w) 61 | (dotimes (y h) 62 | (let ((tile-xy (complex (+ x cx) (+ y cy)))) 63 | (setf (gethash tile-xy map) #\.) 64 | (push tile-xy room-list)))) 65 | (make-corridor new-cent old-cent map) 66 | (genrooms xdim ydim map new-cent room-list (1- count))) 67 | (t (genrooms xdim ydim map old-cent room-list (1- count)))))) 68 | 69 | (defun rcoords (width height corner-x corner-y &aux temp-room) 70 | "Generate a list of coordinates for a room." 71 | (dotimes (x width temp-room) 72 | (dotimes (y height) 73 | (let ((col (+ x corner-x)) 74 | (row (+ y corner-y))) 75 | (push (complex col row) temp-room))))) 76 | 77 | (defun transform-char (x y map) 78 | "Only return the map character if it is near a floor tile." 79 | (let ((count 0)) 80 | (dolist (mod *surr*) 81 | (when (eq (gethash (+ mod (complex x y)) map) #\.) (incf count))) 82 | (if (zerop count) #\SPACE (gethash (complex x y) map)))) 83 | 84 | (defun transform-map (map) 85 | (loop for coord being the hash-keys in map do 86 | (setf (gethash coord map) 87 | (transform-char (realpart coord) (imagpart coord) map)) 88 | finally (return map))) 89 | 90 | (defun print-map2 (xdim ydim map) 91 | (dotimes (y ydim) 92 | (dotimes (x xdim (terpri)) 93 | (princ (gethash (complex x y) map))))) 94 | 95 | (defun print-map (&optional (xdim 40) (ydim 20) (map (mkmap xdim ydim))) 96 | "Print a random map." 97 | (with-output-to-string (stream) 98 | (princ (format nil "```~%") stream) 99 | (dotimes (y ydim (princ (format nil "```") stream)) 100 | (dotimes (x xdim (princ (format nil "~%") stream)) 101 | (princ (transform-char x y map) stream))))) 102 | -------------------------------------------------------------------------------- /tables/README-LICENSE: -------------------------------------------------------------------------------- 1 | The tables in here aren't MIT licensed, but copyright of Whitehack's author, all rights reserved. 2 | -------------------------------------------------------------------------------- /tables/crits.org: -------------------------------------------------------------------------------- 1 | | *d20* | *The target('s) ...* | 2 | |-------+--------------------------------------------------| 3 | | 1 | Weapon flies 10 ft away. | 4 | | 2 | Shield drops 5 ft away. | 5 | | 3 | Weapon breaks. It can be mended. | 6 | | 4 | Shield is ruined. | 7 | | 5 | Armor loses d6 DF. It can be mended. | 8 | | 6 | Is hurt and gets halved movement. | 9 | | 7 | Speech is impossible for 10 minutes. | 10 | | 8 | Screams at the top of her lungs. | 11 | | 9 | Is blinded for 10 min. Related actions are -10. | 12 | | 10 | Is laid flat on the ground a few steps away. | 13 | | 11 | Must save or attempt to flee. | 14 | | 12 | Is deaf for 10 minutes. | 15 | | 13 | Starts to bleed. +1 damage every round. | 16 | | 14 | Takes an additional d6 damage. | 17 | | 15 | Is stunned for 2 rounds: MV 5, -4 DF. | 18 | | 16 | Is confused. Must save or attack nearest ally. | 19 | | 17 | Must save or attack an ally and attempt to flee. | 20 | | 18 | Is shocked and defenseless until rested. | 21 | | 19 | Is knocked out at -1 HP or less. | 22 | | 20 | Meets a gory death. Allies check morale. | 23 | -------------------------------------------------------------------------------- /tables/fumble.org: -------------------------------------------------------------------------------- 1 | | *d6* | *The character('s) ...* | 2 | |------+-------------------------------------------------| 3 | | 1 | Weapon breaks. It can be mended. | 4 | | 2 | Armor or shield breaks. They can be mended. | 5 | | 3 | Weapon drops or gets stuck (player choice). | 6 | | 4 | Staggers and gets 2 rounds of halved movement. | 7 | | 5 | Attacks the nearest ally (make an attack roll). | 8 | | 6 | Hits herself---roll damage! | 9 | -------------------------------------------------------------------------------- /tables/monsters.org: -------------------------------------------------------------------------------- 1 | | *Monster* | *HD* | *DF* | *MV* | *LT* | *Special* | 2 | |--------------+-------+------+-------+------+---------------------------------------------------------------------------------| 3 | | Amphibian | 1--4 | 3 | 25/40 | R | Breathe air/water, swimmer, weird language. | 4 | | Anchorite | 5 | 4 | 15 | H | Snow tunneler, sense movement, scream. | 5 | | Basilisk | 6 | 5 | 20 | +2H | Petrifying gaze. | 6 | | Bear | 5+10 | 3 | 30 | A | Omnivore. | 7 | | Boar | 4 | 2 | 35 | -2A | Charge attack. | 8 | | Cockatrice | 5 | 3 | 15/40 | -2M | Petrifying bite. | 9 | | Demon | 3--9 | 2--7 | 30/40 | +5H | Magick resistance, 1--3 miracles, fire breath. | 10 | | Dog | 1 | 1 | 30 | +2A | Great sense of smell, pack runner. | 11 | | Doppelganger | 4--7 | 2--5 | 30 | M | Change appearance, magick resistance. | 12 | | Dragon | 6--12 | 5--6 | 30/40 | +14H | Intelligent, colored scales, acid/fire/ice/poison/electric breath and immunity. | 13 | | Dryad | 2 | 4 | 30 | M | Charm ability. | 14 | | Dwarf | 2+1 | 5 | 20 | +6R | Stonework insight. | 15 | | Elemental | 8 | 6 | 40 | -2M | Elemental miracles. | 16 | | Elf | 2 | 4 | 30 | R | Exceptional hunter, innate miracle. | 17 | | Fighter | 2 | 5 | 30 | R | Strong ability 8. | 18 | | Fungus | 3 | 2 | 5 | -2M | Tentacles, induce rot disease. | 19 | | Gargoyle | 4 | 4 | 20/40 | -2H | Statue disguise, claws, hunt in pairs. | 20 | | Ghoul | 2 | 3 | 20 | M | Mind magick immunity, paralyzing touch. | 21 | | Giant | 4+7 | 4 | 40 | +2M | Cold immunity, berserk. | 22 | | Goblin | 1 | 3 | 20 | R | Dirty fighting, improvised weapons. Shamans have miracles. | 23 | | Golem | 12 | 0 | 20 | -6M | Immunity to normal weapons, fire & cold. | 24 | | Griffon | 7 | 6 | 25/40 | H | Cunning. | 25 | | Harpy | 3 | 2 | 10/25 | M | Charm ability | 26 | | Hobgoblin | 2+2 | 4 | 25 | R | Strong ability 2. | 27 | | Hydra | 7 | 4 | 15 | +6H | Regenerate head. | 28 | | Illsprout | 1 | 5 | 25 | +2M | Plantoid, poison, plant bad seed. | 29 | | Insectoid | 3 | 6 | 30 | M | Hive mind. | 30 | | Swarm | 1 | 0 | 20 | -- | Insects, must be killed with area damage. | 31 | | Kobold | 1 | 3 | 30 | +2R | Omnivore. | 32 | | Kraken | 12 | 5 | 40 | +8H | Eight tentacles. | 33 | | Lizardman | 2+1 | 4 | 25/30 | R | Hold breath, tail attack. | 34 | | Minotaur | 5+4 | 3 | 30 | M | Never lost in labyrinths, berserker. | 35 | | Mummy | 5+1 | 6 | 20 | H | Disease, fire vulnerability, normal weapon immunity. | 36 | | Ogre | 4+1 | 4 | 25 | H | Mages have miracles. | 37 | | Orc | 2 | 3 | 25 | R | Tough. | 38 | | Monkey | 1* | 4 | 25 | A | Snow version. Sense anchorite, trainable. | 39 | | Morlock | 1 | 1 | 25 | R | \textls[-41]Sense heat. Light vulnerability. | 40 | | Roc | 12 | 5 | 50 | +2H | Protective. | 41 | | Sea Serpent | 17 | 7 | 60 | H | Crush ship. | 42 | | Shadow | 3 | 3 | 25 | -2M | Draw strength. | 43 | | Skeleton | 1 | 2 | 25 | R | Piercing resistant. | 44 | | Spectre | 6 | 7 | 30 | -- | Incorporeal, drain levels. | 45 | | Spider | 2+2 | 3 | 30 | +2H | Giant version. Poison, web. | 46 | | Troll | 6+3 | 5 | 30 | +6H | Regeneration. | 47 | | Vampire | 8 | 7 | 30 | +12H | Transformation, enslaving bite, resurrection. | 48 | | Werewolf | 3 | 4 | 30 | M | Lycanthropy, hurt by silver. | 49 | | Wererat | 3 | 3 | 25 | M | Lycanthropy, control rats. | 50 | | Wight | 3 | 4 | 25 | +10H | Draw levels, normal weapons immunity. | 51 | | Will-o-Wisp | 1* | 9 | 30 | -- | Only hurt by magick weapons, shock. | 52 | | Wolf | 2 | 3 | 40 | A | Pack hunter, tracker. | 53 | | Wyvern | 7 | 6 | 25/40 | +12H | Poisonous sting. | 54 | | Zombie | 1 | 1 | 15 | -- | Rot disease. | 55 | 56 | -------------------------------------------------------------------------------- /tasks-attacks-roller.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Whiteshell tasks and attacks roller 2 | 3 | (in-package #:whiteshell) 4 | 5 | (defun attack (score defense &rest mods) 6 | "Roll a d20 against SCORE and DEFENSE with any number of MODS, returning quality and result category." 7 | (let* ((d20 (1+ (random 20))) 8 | (surplus (if (> score 20) (- score 20) 0)) 9 | (target (reduce #'+ (cons score mods)))) 10 | (cond ((<= (+ d20 surplus) defense) 11 | (values (+ d20 surplus) 'plink)) 12 | ((= d20 20) 13 | (values 20.0 (if (zerop surplus) 'fumble 'failure))) 14 | ((and (= d20 19) (>= target 20)) 15 | (values (+ d20 surplus) 'crit)) 16 | ((< d20 target) 17 | (values (+ d20 surplus) 'success)) 18 | ((> d20 target) 19 | (values d20 'failure)) 20 | (t (values d20 'crit))))) 21 | 22 | (defun quantified (result) 23 | "Take a RESULT category and return a quantification." 24 | (case result 25 | (fumble 0) 26 | (failure 1) 27 | (plink 2) 28 | (success 3) 29 | (crit 4))) 30 | 31 | (defun compare-rolls (kind q1 r1 q2 r2) 32 | "Compare two pairs of quality and result category, returning the pair that 'wins,' based on the KIND of comparison (positive or negative)." 33 | (let ((comparison (- (quantified r1) 34 | (quantified r2)))) 35 | (cond ((minusp comparison) 36 | (if (eq kind 'positive) 37 | (values q2 r2) 38 | (values q1 r1))) 39 | ((zerop comparison) 40 | (if (eq kind 'positive) 41 | (if (> q1 q2) 42 | (values q1 r1) 43 | (values q2 r2)) 44 | (if (< q1 q2) 45 | (values q1 r1) 46 | (values q2 r2)))) 47 | (t (if (eq kind 'positive) 48 | (values q1 r1) 49 | (values q2 r2)))))) 50 | 51 | (defun double-attack (kind score defense &rest mods) 52 | "Make a double roll attack using SCORE, DEFENSE and any number of MODS. Although it isn't in the rules, you can use this to make a negative double attack as well." 53 | (multiple-value-bind (q1 r1) 54 | (apply #'attack score defense mods) 55 | (multiple-value-bind (q2 r2) 56 | (apply #'attack score defense mods) 57 | (compare-rolls kind q1 r1 q2 r2)))) 58 | 59 | (defun a (score defense &rest mods) 60 | "Shortcut for an attack." 61 | (multiple-value-call #'consequences (apply #'attack score defense mods))) 62 | 63 | (defun d (score defense &rest mods) 64 | "Shortcut for a double attack." 65 | (multiple-value-call #'consequences 66 | (apply #'double-attack 'positive score defense mods))) 67 | 68 | (defun r (score &rest mods) 69 | "Shortcut for a regular taskroll." 70 | (format nil "~{~a~^ ~}" 71 | (multiple-value-list (apply #'attack score 0 mods)))) 72 | 73 | (defun +dr (score &rest mods) 74 | "Shortcut for a positive double taskroll." 75 | (format nil "~{~a~^ ~}" 76 | (multiple-value-list 77 | (apply #'double-attack 'positive score 0 mods)))) 78 | 79 | (defun -dr (score &rest mods) 80 | "Shortcut for a negative double taskroll." 81 | (format nil "~{~a~^ ~}" 82 | (multiple-value-list 83 | (apply #'double-attack 'negative score 0 mods)))) 84 | 85 | 86 | -------------------------------------------------------------------------------- /whiteshell.asd: -------------------------------------------------------------------------------- 1 | ;;;; whiteshell.asd 2 | 3 | (asdf:defsystem #:whiteshell 4 | :description "A collection of helper tools for the tabletop role-playing game Whitehack." 5 | :author "Christian Mehrstam " 6 | :license "MIT for the actual code. Standard copyright all rights reserved for any Whitehack content." 7 | :serial t 8 | :depends-on () 9 | :components ((:file "package") 10 | (:file "tasks-attacks-roller") 11 | (:file "simple-maps") 12 | (:file "whiteshell") 13 | (:file "hp-roller") 14 | (:file "read-org-tables") 15 | (:file "damage-roller"))) 16 | 17 | -------------------------------------------------------------------------------- /whiteshell.lisp: -------------------------------------------------------------------------------- 1 | ;;;; whiteshell.lisp 2 | 3 | (in-package #:whiteshell) 4 | 5 | #+win32 6 | (progn (cffi:define-foreign-library blt:bearlibterminal 7 | (t "./BearLibTerminal.dll")) 8 | (cffi:use-foreign-library blt:bearlibterminal)) 9 | 10 | (defun random-item (input &optional pretty) 11 | "Return or print a random item either from a file with a list or an actual Lisp list." 12 | (let* ((thelist (if (listp input) input (uiop:read-file-lines input))) 13 | (pick (nth (random (length thelist)) thelist))) 14 | (if pretty (format t "~a" pick) pick))) 15 | 16 | (defmacro average (expr &optional (times 1000)) 17 | `(values (round (loop for n from 1 to ,times 18 | sum ,expr) 19 | ,times))) 20 | (defun div (a b) 21 | (float (/ a b))) 22 | 23 | (defun whiteshell () 24 | (format t "Welcome to the Whiteshell REPL. Type 'i' for commands.~%") 25 | (weak-repl)) 26 | 27 | (defun weak-repl () 28 | (format t "> ") 29 | (flet ((illegalp (str) 30 | (intersection (coerce str 'list) '(#\( #\) #\' #\, #\`)))) 31 | (let* ((commands (append '(average-hp hp-roller print-map quit 32 | a d r +dr -dr monster) 33 | (loop for n to 30 collect n))) 34 | (str (read-line)) 35 | (inp (if (illegalp str) 36 | '(bad) 37 | (read-from-string (format nil "(~a)" str)))) 38 | (input (cons (car inp) 39 | (mapcar #'(lambda (a) `',a) (cdr inp))))) 40 | (cond ((member (car input) commands) 41 | (unless (and (eq (car input) 'quit) (print 'bye!)) 42 | (format t "~{~a ~}~%" (multiple-value-list 43 | (eval (if (numberp (car input)) 44 | (cons 'a input) 45 | input)))) 46 | (weak-repl))) 47 | (t (format t "Allowed commands:~{ ~a~}.~%" commands) 48 | (weak-repl)))))) 49 | 50 | (defun bot () 51 | (setf *random-state* (make-random-state t)) 52 | (let ((args (uiop:command-line-arguments))) 53 | (if (and (member (car args) 54 | '("whiteshell::average-hp" "whiteshell::hp-roller" 55 | "whiteshell::print-map" "whiteshell::quit" 56 | "whiteshell::r" "whiteshell::+dr" "whiteshell::-dr" 57 | "whiteshell::a" "whiteshell::d" "whiteshell::monster") 58 | :test #'string=) 59 | (null (intersection '(#\( #\) #\' #\, #\`) 60 | (coerce (format nil "~{~a~^ ~}" args) 'list)))) 61 | (let ((output (apply (read-from-string 62 | (car args)) 63 | (mapcar #'read-from-string 64 | (cdr args))))) 65 | (when output (print output) (terpri))) 66 | (format t "Not allowed.~%")))) 67 | --------------------------------------------------------------------------------