├── .gitignore ├── LICENSES.rst ├── README.rst ├── module-order.txt ├── roguetv ├── __init__.py ├── actions.hy ├── attrstr.hy ├── cmdline.hy ├── creature │ ├── __init__.py │ ├── generic.hy │ ├── monster.hy │ └── player.hy ├── display.hy ├── english.hy ├── fov.py ├── globals.hy ├── input.hy ├── item │ ├── __init__.py │ ├── burden.hy │ ├── clothing.hy │ ├── gadget.hy │ ├── generic.hy │ ├── misc.hy │ └── soda.hy ├── macros.hy ├── main.hy ├── map.hy ├── mapgen.hy ├── saves.hy ├── scores.hy ├── strings.hy ├── types.hy ├── util.hy └── xterm_colors.hy ├── run.hy ├── test └── test_english.hy └── tools ├── build-bundles.hy ├── check-module-order.hy ├── chest-probs.hy ├── generation-counts.hy ├── generation-probs.hy ├── run-posix.sh ├── run-windows.bat ├── run-windows.sh └── tabulate-items.hy /.gitignore: -------------------------------------------------------------------------------- 1 | *.pyc 2 | /roguetv_init.hy 3 | /build 4 | -------------------------------------------------------------------------------- /LICENSES.rst: -------------------------------------------------------------------------------- 1 | This file contains license information for Rogue TV and for various libraries that are distributed with it in prepackaged bundles. 2 | 3 | License for Rogue TV proper, Kodhy, and Heidegger 4 | ============================================================ 5 | 6 | This program is copyright 2015, 2016, 2017 Kodi Arfer. 7 | 8 | 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 of the License, or (at your option) any later version. 9 | 10 | 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. 11 | 12 | .. _`GNU General Public License`: http://www.gnu.org/licenses/ 13 | 14 | License for Hy 15 | ============== 16 | 17 | Permission is hereby granted, free of charge, to any person obtaining a 18 | copy of this software and associated documentation files (the "Software"), 19 | to deal in the Software without restriction, including without limitation 20 | the rights to use, copy, modify, merge, publish, distribute, sublicense, 21 | and/or sell copies of the Software, and to permit persons to whom the 22 | Software is furnished to do so, subject to the following conditions: 23 | 24 | The above copyright notice and this permission notice shall be included in 25 | all copies or substantial portions of the Software. 26 | 27 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 28 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 29 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 30 | THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 31 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 32 | FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 33 | DEALINGS IN THE SOFTWARE. 34 | 35 | License for appdirs 36 | =================== 37 | 38 | # This is the MIT license 39 | 40 | Copyright (c) 2010 ActiveState Software Inc. 41 | 42 | Permission is hereby granted, free of charge, to any person obtaining a 43 | copy of this software and associated documentation files (the 44 | "Software"), to deal in the Software without restriction, including 45 | without limitation the rights to use, copy, modify, merge, publish, 46 | distribute, sublicense, and/or sell copies of the Software, and to 47 | permit persons to whom the Software is furnished to do so, subject to 48 | the following conditions: 49 | 50 | The above copyright notice and this permission notice shall be included 51 | in all copies or substantial portions of the Software. 52 | 53 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS 54 | OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 55 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 56 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 57 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 58 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 59 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 60 | 61 | License for inflect.py 62 | ====================== 63 | 64 | Copyright (C) 2010 Paul Dyson 65 | 66 | Based upon the Perl module Lingua::EN::Inflect by Damian Conway. 67 | 68 | This program is free software: you can redistribute it and/or modify 69 | it under the terms of the GNU Affero General Public License as published by 70 | the Free Software Foundation, either version 3 of the License, or 71 | (at your option) any later version. 72 | 73 | This program is distributed in the hope that it will be useful, 74 | but WITHOUT ANY WARRANTY; without even the implied warranty of 75 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 76 | GNU General Public License for more details. 77 | 78 | You should have received a copy of the GNU Affero General Public License 79 | along with this program. If not, see . 80 | 81 | The original Perl module Lingua::EN::Inflect by Damian Conway is 82 | available from http://search.cpan.org/~dconway/ 83 | 84 | License for jsonpickle 85 | ====================== 86 | 87 | Copyright (C) 2008 John Paulett (john -at- paulett.org) 88 | Copyright (C) 2009, 2011, 2013 David Aguilar (davvid -at- gmail.com) 89 | All rights reserved. 90 | 91 | Redistribution and use in source and binary forms, with or without 92 | modification, are permitted provided that the following conditions 93 | are met: 94 | 95 | 1. Redistributions of source code must retain the above copyright 96 | notice, this list of conditions and the following disclaimer. 97 | 2. Redistributions in binary form must reproduce the above copyright 98 | notice, this list of conditions and the following disclaimer in 99 | the documentation and/or other materials provided with the 100 | distribution. 101 | 3. The name of the author may not be used to endorse or promote 102 | products derived from this software without specific prior 103 | written permission. 104 | 105 | THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS 106 | OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 107 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 108 | ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 109 | DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 110 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE 111 | GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 112 | INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 113 | IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR 114 | OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN 115 | IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 116 | 117 | PyPaths 118 | ======= 119 | 120 | PyPaths__ has no license. On 24 May 2015, I sent an email to the author, Jonathan Hood, asking about this, but I never heard back. Worse comes to worse, I'll reimplement the subroutines I've used from it. 121 | 122 | .. __: https://github.com/jonathanhood/pypaths 123 | -------------------------------------------------------------------------------- /README.rst: -------------------------------------------------------------------------------- 1 | Update on 13 Nov 2023: I abandoned this project, in a working but incomplete state, in 2017. It requires various old versions of its dependencies, particularly Hy, to run. I went on to reuse a few of its ideas in `Infinitesimal Quest 2 + ε `__. 2 | 3 | -------------------------------------------------- 4 | 5 | Rogue TV is a nonviolent roguelike where you play a lucky contestant on a roguelike-themed game show. It draws inspiration from `Smash TV`_, `Weekend Warrior`_, MXC_, `Legends of the Hidden Temple`_, `Mazeworld Catacombs`_, `Scarab of RA`_, NetHack_, and, of course, Rogue_. It's written in Hy_ with Python 3. It runs on both CPython and PyPy; you can get better performance, especially for map generation, on PyPy. 6 | 7 | .. figure:: http://i.imgur.com/vcPgIAK.png 8 | :alt: Screenshot of an ASCII roguelike 9 | 10 | Running in GNOME Terminal on Linux. 11 | 12 | Currently, the game is playable, but a lot of features remain to be implemented. 13 | 14 | Dependencies include Hy_ (``3db13ec71f2c79a1b91f3e0a7169d85658a410a1``), Kodhy_, Heidegger_, and curses. (All dependencies not already included with Python are in pure Python or Hy.) You can download the game and its dependencies as a self-contained bundle for `Unix-likes (POSIX-compliant systems)`_ or `Windows (64-bit only)`_. The POSIX bundle has been tested with Linux and Mac OS X, as well as Windows with Cygwin_ and Cygwin's Python installed. The Windows bundle includes a subset of Cygwin and Python so you don't have to install these first. I keep both bundles up to date with the master branch on GitHub. 15 | 16 | .. _Unix-likes (POSIX-compliant systems): http://arfer.net/downloads/roguetv-posix.tar.gz 17 | .. _Windows (64-bit only): http://arfer.net/downloads/roguetv-windows.tar.gz 18 | 19 | To start the game: 20 | 21 | - From the POSIX bundle, type ``sh run.sh``. 22 | - From the Windows bundle, double-click ``run.bat`` (its name may appear as ``run`` if you have file extensions hidden) to get a command window, then type ``sh run.sh`` and hit Enter. 23 | - From the source code, type ``hy run.hy``. 24 | 25 | Use the ``--help`` argument to see command-line options. The game requires a terminal emulator that supports 256 colors and Unicode, such as GNOME Terminal, Konsole, LXTerminal, Terminal.app, or Mintty. It works fine over SSH or in screen or tmux. 26 | 27 | Please `send me`__ bug reports and patches. Feature suggestions are also welcome, but I've got a lot planned already. 28 | 29 | .. __: http://arfer.net/elsewhere 30 | 31 | How to play 32 | ============================================================ 33 | 34 | Press the ``?`` key to see controls. 35 | 36 | Detailed descriptions of every item, creature, and kind of terrain are available in-game. To see them, enter look mode (``;``) or the inventory list (``i``) and press the appropriate key. 37 | 38 | In the status bar, the number in parenthesis next to the time remaining is the amount of time your last action took, in seconds. If there is no number, your last action took no time. 39 | 40 | The object of the game is to maximize your winnings. Your winnings are the sum of the monetary values of the items you're carrying. More broadly, the goal is to maximize your *average* winnings across many games of Rogue TV. If you take an up elevator, or you win the game (by taking the final down elevator with the Amulet of Yendor), you get to keep all your winnings. But if you run out of time or resign, prizes are taken away from you until you have half your original winnings or less. So, it's sometimes wiser to take an up elevator than to press your luck in pursuit of the Amulet. 41 | 42 | .. _Hy: http://hylang.org 43 | .. _Kodhy: https://github.com/Kodiologist/Kodhy 44 | .. _Heidegger: https://github.com/Kodiologist/Heidegger 45 | .. _Cygwin: https://cygwin.com 46 | 47 | .. _Smash TV: http://en.wikipedia.org/wiki/Smash_TV 48 | .. _Weekend Warrior: http://www.pangeasoft.net/weekendwarrior.html 49 | .. _Legends of the Hidden Temple: http://en.wikipedia.org/wiki/Legends_of_the_Hidden_Temple 50 | .. _MXC: http://en.wikipedia.org/wiki/MXC 51 | .. _Mazeworld Catacombs: http://macintoshgarden.org/games/mazeworld-catacombs 52 | .. _Scarab of RA: http://macintoshgarden.org/games/scarab-of-ra 53 | .. _NetHack: http://nethack4.org 54 | .. _Rogue: http://en.wikipedia.org/wiki/Rogue_(video_game) 55 | -------------------------------------------------------------------------------- /module-order.txt: -------------------------------------------------------------------------------- 1 | appdirs 2 | jsonpickle 3 | inflect 4 | pypaths 5 | 6 | heidegger.pos 7 | heidegger.digger 8 | 9 | kodhy.util 10 | 11 | roguetv.macros 12 | roguetv.strings 13 | roguetv.english 14 | roguetv.xterm_colors 15 | roguetv.globals 16 | roguetv.util 17 | roguetv.cmdline 18 | roguetv.input 19 | roguetv.types 20 | roguetv.map 21 | roguetv.fov 22 | roguetv.item 23 | roguetv.item.generic 24 | roguetv.creature 25 | roguetv.creature.generic 26 | roguetv.creature.monster 27 | roguetv.item.gadget 28 | roguetv.item.soda 29 | roguetv.item.clothing 30 | roguetv.item.burden 31 | roguetv.item.misc 32 | roguetv.mapgen 33 | roguetv.attrstr 34 | roguetv.display 35 | roguetv.actions 36 | roguetv.creature.player 37 | roguetv.saves 38 | roguetv.scores 39 | roguetv.main 40 | -------------------------------------------------------------------------------- /roguetv/__init__.py: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Kodiologist/Rogue-TV/003a9c20da855b5e11f12ea7643918fd929a2447/roguetv/__init__.py -------------------------------------------------------------------------------- /roguetv/actions.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [amap filt block retf]] [roguetv.macros [*]]) 2 | 3 | (import 4 | [heidegger.pos [Pos]] 5 | [kodhy.util [T F ret]] 6 | [roguetv.globals :as G] 7 | [roguetv.util [*]] 8 | [roguetv.input [text-screen message-log-screen inventory-loop look-mode user-confirms normal-command-keys]] 9 | [roguetv.map [Tile Wall mset]] 10 | [roguetv.item [Item add-to-inventory drop-pos]] 11 | [roguetv.creature [Creature]] 12 | [roguetv.display [draw-inventory describe-tile]]) 13 | 14 | (defmacro when-debugging [&rest body] 15 | `(if G.debug 16 | (do ~@body) 17 | (msg "That command requires debug mode."))) 18 | 19 | (defn do-normal-command [inp] 20 | 21 | (update-msg-highlighting) 22 | 23 | (setv cmd (if (coll? inp) (first inp) inp)) 24 | (setv arg (when (coll? inp) (second inp))) 25 | 26 | (block (cond 27 | 28 | [(= cmd :help) 29 | (text-screen (+ 30 | "Controls\n\n" 31 | "Use the arrow keys, the number pad, or the vi keys to move. Use \".\" or numpad \"5\" to wait 1 second. All controls are case-sensitive.\n\n" 32 | (.join "\n" 33 | (amap (.format " {} {}" (first it) (get it 2)) 34 | (filt (!= (get it 2) :debug) 35 | normal-command-keys))) 36 | "\n\nSave path: " G.save-file-path 37 | "\nScores path: " G.scores-file-path))] 38 | 39 | [(= cmd :resign-game) 40 | (if G.debug 41 | (retf :curses-wrapper :fast-quit) 42 | (do 43 | (msg "Do you really want to resign this game?") 44 | (when (user-confirms) 45 | (setv G.endgame :resigned))))] 46 | 47 | [(= cmd :save-and-quit) 48 | (retf :curses-wrapper :save-and-quit)] 49 | 50 | [(= cmd :move) 51 | (.walk-to G.player (+ G.player.pos arg))] 52 | 53 | [(= cmd :wait) 54 | (.wait G.player)] 55 | 56 | [(= cmd :message-log) 57 | (message-log-screen)] 58 | 59 | [(= cmd :look-mode) 60 | (look-mode G.player.pos)] 61 | 62 | [(= cmd :examine-ground) (do 63 | (describe-tile G.player.pos :verbose T))] 64 | 65 | [(= cmd :use-tile) 66 | (.use-tile (Tile.at G.player.pos))] 67 | 68 | [(= cmd :inventory) (block 69 | (unless G.inventory 70 | (msg "Your inventory is empty.") 71 | (ret)) 72 | (setv i (inventory-loop "You are carrying: (press a key to examine)")) 73 | (when (none? i) 74 | ; No item chosen to examine. 75 | (ret)) 76 | (text-screen (.information (get G.inventory i))))] 77 | 78 | [(= cmd :pick-up) (do 79 | (setv t (Tile.at G.player.pos)) 80 | (when (and t.container (not (.can-see-contents G.player t))) 81 | (msg "{:The} {:v:is} closed. You can't even see if there's anything in {:him}." t t t) 82 | (ret)) 83 | (setv item (Item.at G.player.pos)) 84 | (when (none? item) 85 | (msg "There's nothing here to pick up.") 86 | (ret)) 87 | (when t.container 88 | (msg "{:The} {:v:is} inside {:the}, which {:v:is} closed." item item t t) 89 | (ret)) 90 | (when (= (len G.inventory) G.inventory-limit) 91 | (msg 'tara "{p:The} has {p:his} eyes on another prize, but {p:his} inventory is full. {p:He} can only carry up to {} items." 92 | G.inventory-limit) 93 | (ret)) 94 | (.take-time G.player G.player.take-item-time) 95 | (add-to-inventory item) 96 | (msg "Taken: {}" (item.invstr)))] 97 | 98 | [(= cmd :drop) (do 99 | (unless (.use-item-while-here (Tile.at G.player.pos)) 100 | (ret)) 101 | (unless G.inventory 102 | (you-dont-have-anything-to "drop") 103 | (ret)) 104 | (setv i (inventory-loop "What do you want to drop?")) 105 | (when (none? i) 106 | ; Action canceled. 107 | (ret)) 108 | (setv item (get G.inventory i)) 109 | (when item.curse 110 | (msg 'tara "{:The} {:v:is} cursed! {p:The} can't drop {:him}." 111 | item item item) 112 | (ret)) 113 | (setv clear-spot (drop-pos G.player.pos)) 114 | (unless clear-spot 115 | (msg 'bob "There ain't room on the ground for that truck.") 116 | (ret)) 117 | (.take-time G.player G.player.drop-item-time) 118 | (.pop G.inventory i) 119 | (.move item clear-spot) 120 | (msg "Dropped: {}" (item.invstr)))] 121 | 122 | [(= cmd :apply-item) (do 123 | (unless (.use-item-while-here (Tile.at G.player.pos)) 124 | (ret)) 125 | (unless G.inventory 126 | (you-dont-have-anything-to "apply") 127 | (ret)) 128 | (setv i (inventory-loop "What do you want to apply?")) 129 | (when (none? i) 130 | ; Action canceled. 131 | (ret)) 132 | (setv item (get G.inventory i)) 133 | (.applied item))] 134 | 135 | [(= cmd :make-wall) (when-debugging 136 | (mset G.player.pos (Wall)))] 137 | 138 | [(= cmd :reset-level) (when-debugging 139 | (rtv mapgen.reset-level T))] 140 | 141 | [T 142 | (raise (ValueError (.format "Unknown command {!r}" cmd)))]))) 143 | -------------------------------------------------------------------------------- /roguetv/attrstr.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [amap ecase]] [roguetv.macros [*]]) 2 | 3 | (import 4 | re 5 | xml.etree.ElementTree 6 | curses 7 | [kodhy.util [str->keyword keyword->str]] 8 | roguetv.xterm-colors 9 | [roguetv.globals :as G]) 10 | 11 | (defn get-color [fg &optional bg] 12 | (when (none? fg) 13 | (setv fg G.fg-color)) 14 | (when (none? bg) 15 | (setv bg (G.pick-bg-color fg))) 16 | (curses.color-pair (try 17 | (get G.color-pairs (, fg bg)) 18 | (except [KeyError] 19 | ; This color pair hasn't been initialized yet. So do that. 20 | ; First ensure each color is defined correctly to have its 21 | ; usual value under xterm. 22 | (when (curses.can-change-color) 23 | (for [c [fg bg]] 24 | (setv cn (get G.color-numbers c)) 25 | (curses.init-color cn #* (amap 26 | (int (* it (/ 1000 256))) 27 | (get roguetv.xterm-colors.table cn))))) 28 | ; Now create the color pair. 29 | (setv i (+ 2 (len G.color-pairs))) 30 | (curses.init-pair i (get G.color-numbers fg) (get G.color-numbers bg)) 31 | (setv (get G.color-pairs (, fg bg)) i) 32 | i)))) 33 | 34 | (defn default-color [] 35 | (get-color G.fg-color)) 36 | 37 | (defn curses-encode [s] 38 | (.encode s G.locale-encoding)) 39 | 40 | (defn -elem-attrs [e] 41 | ; Translates an xml.etree.ElementTree.Element to curses 42 | ; attributes. 43 | (ecase e.tag 44 | ["root" 45 | 0] 46 | ["b" 47 | curses.A-BOLD] 48 | ["c" 49 | (get-color 50 | (and (.get e "fg") (str->keyword (.get e "fg"))) 51 | (and (.get e "bg") (str->keyword (.get e "bg"))))])) 52 | 53 | (defn -from-xml-f [elem a] 54 | (|= a (-elem-attrs elem)) 55 | (setv chars (or elem.text "")) 56 | (setv attrs (* [a] (len chars))) 57 | (for [child elem] 58 | (setv [new-chars new-attrs] (-from-xml-f child a)) 59 | (+= chars (+ new-chars (or child.tail ""))) 60 | (+= attrs (+ new-attrs (* [a] (len (or child.tail "")))))) 61 | (, chars attrs)) 62 | 63 | (setv ws-re (re.compile r"(\s+)")) 64 | 65 | (defclass AttrStr [object] [ 66 | ; An AttrStr is a string with an accompanying list of curses 67 | ; attributes for each character. 68 | 69 | __init__ (fn [self &optional chars attrs] 70 | (setv self.chars (or chars "")) 71 | (setv self.attrs (or attrs [])) 72 | (assert (= (len self.chars) (len self.attrs))) 73 | None) 74 | 75 | from-xml (classmethod (fn [self xml-string] 76 | (setv root (xml.etree.ElementTree.fromstring 77 | (.encode (+ "" xml-string "") "UTF-8"))) 78 | (AttrStr #* (-from-xml-f root 0)))) 79 | 80 | __repr__ (fn [self] 81 | (.format "AttrStr({!r}, {!r})" self.chars self.attrs)) 82 | 83 | __len__ (fn [self] 84 | (len self.chars)) 85 | 86 | draw (fn [self &optional extra-attrs] 87 | (for [[c a] (zip self.chars self.attrs)] 88 | (try 89 | (G.T.addstr (curses-encode c) (| (or a 0) (or extra-attrs 0))) 90 | (except [curses.error] None)))) 91 | ; http://bugs.python.org/issue8243 92 | 93 | ljust (fn [self width] 94 | (AttrStr 95 | (.ljust self.chars width) 96 | (+ self.attrs (* [None] (max 0 (- width (len self.chars))))))) 97 | 98 | trunc (fn [self width] 99 | (if (<= (len self) width) 100 | self 101 | (AttrStr (cut self.chars 0 width) (cut self.attrs 0 width)))) 102 | 103 | wrap (fn [self width] 104 | ; Returns a list of AttrStrs, each no longer than the 105 | ; specified width. 106 | (setv lines []) 107 | (setv line-chars "") 108 | (setv line-attrs []) 109 | (setv chunks (.split ws-re self.chars)) 110 | (setv attrs (list self.attrs)) 111 | (defn shift-attrs [n] 112 | ; Removes and returns the first `n` attrs. 113 | (amap (.pop attrs 0) (range n))) 114 | ; Remove trailing whitespace. 115 | (when (.isspace (get chunks -1)) 116 | (.pop chunks)) 117 | ; Begin the list with a zero-length fake whitespace 118 | ; element. 119 | (when (.isspace (first chunks)) 120 | (shift-attrs (len (first chunks))) 121 | (del (get chunks 0))) 122 | (.insert chunks 0 "") 123 | (for [[ws nonws] (zip (cut chunks 0 None 2) (cut chunks 1 None 2))] 124 | (when (> (+ (len line-chars) (len ws) (len nonws)) width) 125 | ; This line is full. Move on to the next line. 126 | (.append lines (AttrStr line-chars line-attrs)) 127 | (setv line-chars "") 128 | (setv line-attrs []) 129 | ; Clear the whitespace chunk. We don't need whitespace 130 | ; at the beginning of a line. 131 | (shift-attrs (len ws)) 132 | (setv ws "")) 133 | ; Append the chunks. 134 | (+= line-chars (+ ws nonws)) 135 | (+= line-attrs (shift-attrs (+ (len ws) (len nonws))))) 136 | (.append lines (AttrStr line-chars line-attrs)) 137 | lines)]) 138 | -------------------------------------------------------------------------------- /roguetv/cmdline.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [amap amap2 whenn λ qw]]) 2 | 3 | (import 4 | sys 5 | os 6 | os.path 7 | errno 8 | random 9 | [collections [OrderedDict]] 10 | argparse 11 | appdirs 12 | [kodhy.util [T F ret by-ns concat keyword->str str->keyword]] 13 | [roguetv.english [genders NounPhrase]] 14 | [roguetv.globals :as G]) 15 | 16 | (defn parse-env [] 17 | (setv G.version-info "Not a bundled version") 18 | (whenn (os.getenv "ROGUETV_BUNDLE_INFO") 19 | (setv [l1 l2 l3] (.split it "\n")) 20 | (setv G.bundle-os l1) 21 | (setv G.bundle-git (cut l2 (len "Git commit "))) 22 | (setv (get G.dates "bundle_created") (cut l3 (len "Packaged at "))) 23 | (setv G.version-info (.format "Bundle version {}-{} ({})" 24 | (cut G.bundle-git 0 12) G.bundle-os (get G.dates "bundle_created"))))) 25 | 26 | (def pronouns->genders (OrderedDict [ 27 | (, "he" :male) 28 | (, "she" :female) 29 | (, "it" :neuter)])) 30 | 31 | (defn uni [s] 32 | (.decode s (sys.getfilesystemencoding))) 33 | 34 | (defn parse-args [&optional args] 35 | (setv desc (+ "Rogue TV by Kodi Arfer\n" G.version-info)) 36 | 37 | (setv parser (argparse.ArgumentParser 38 | :formatter-class argparse.RawDescriptionHelpFormatter 39 | :description desc)) 40 | 41 | (setv parameters [ 42 | ["version" 43 | :action "version" 44 | :version desc] 45 | ["name" :type uni 46 | :metavar "TEXT" 47 | :help "name of your character (new game only)"] 48 | ["pronouns" :type uni 49 | :help "pronouns for your character (new game only)" 50 | :choices (amap (str it) (.keys pronouns->genders))] 51 | ["map-seed" :type int 52 | :metavar "INTEGER" 53 | :help "RNG seed for generating the dungeon (new game only)"] 54 | ["general-seed" :type int 55 | :metavar "INTEGER" 56 | :help "RNG seed for all other events (new game only)"] 57 | ["start-at-dl" 58 | :metavar "INTEGER" 59 | :type (λ 60 | (setv it (- (int it) 1)) 61 | (unless (<= 0 it G.max-dungeon-level) 62 | (raise (argparse.ArgumentTypeError "no such dungeon level"))) 63 | it) 64 | :help "starting dungeon level (new game only)"] 65 | ["save" :type uni 66 | :metavar "FILEPATH" 67 | :help "where to read saved games and write saved games to"] 68 | ["no-autosave" 69 | :help "don't automatically save at the end of each level" 70 | :action "store_true"] 71 | ["scores" :type uni 72 | :metavar "FILEPATH" 73 | :help "where to store scores"] 74 | ["show-scores" 75 | :help "instead of starting a game, show scores" 76 | :action "store_true"] 77 | ["show-all-scores" 78 | :help "like --show-scores, but show every game" 79 | :action "store_true"] 80 | ["debug" 81 | :help "enable debug mode" 82 | :action "store_true"]]) 83 | 84 | (for [x parameters] 85 | (.add-argument parser (+ "--" (first x)) #** (dict 86 | (amap2 (, (keyword->str a) b) (rest x))))) 87 | (setv p (.parse-args parser args)) 88 | 89 | (unless p.save 90 | (setv p.save (os.path.join (default-dir) "saved-game.json.gz"))) 91 | 92 | (unless p.scores 93 | (setv p.scores (os.path.join (default-dir) "scores.json"))) 94 | 95 | (for [a ["map_seed" "general_seed"]] 96 | (unless (getattr p a) 97 | (setattr p a (random.randrange (- (** 2 63)) (- (** 2 63) 1))))) 98 | 99 | (unless p.pronouns 100 | (when p.name 101 | (sys.exit "You set --name, so you probably want to set --pronouns, too.")) 102 | (setv p.pronouns (random.choice ["he" "she"]))) 103 | (setv p.gender (get pronouns->genders p.pronouns)) 104 | 105 | (unless p.name 106 | (setv p.name (cond 107 | [(= p.gender :male) 108 | (random.choice (qw Matthew Mark Luke John))] 109 | ; The four gospels 110 | [(= p.gender :female) 111 | (random.choice (qw Meg Jo Beth Amy))] 112 | ; Little Women 113 | [T 114 | (random.choice (+ 115 | (qw Zorx Klax Jennifer) 116 | ; Captain Underpants and the Invasion of the Incredibly Naughty Cafeteria Ladies from Outer Space (and the Subsequent Assault of the Equally Evil Lunchroom Zombie Nerds) 117 | ["Robert'); DROP TABLE Players;--"]))]))) 118 | ; http://www.xkcd.com/327/ 119 | (setv p.name (NounPhrase p.name :bare-proper T :gender p.gender)) 120 | 121 | p) 122 | 123 | (defn default-dir [] 124 | (if (= G.bundle-os "windows") 125 | ".." ; This should be the bundle directory. 126 | (do 127 | (setv d (appdirs.user-data-dir "Rogue TV" "Kodiologist")) 128 | (try 129 | (os.makedirs d) 130 | (except [e OSError] 131 | (unless (= e.errno errno.EEXIST) 132 | (raise)))) 133 | d))) 134 | -------------------------------------------------------------------------------- /roguetv/creature/__init__.py: -------------------------------------------------------------------------------- 1 | from roguetv.creature.generic import * 2 | 3 | # Make sure all the descendant modules are imported, for their 4 | # effects on global variables (like item definitions). 5 | import roguetv.creature.monster 6 | import roguetv.creature.player 7 | -------------------------------------------------------------------------------- /roguetv/creature/generic.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [afind-or whenn block meth cmeth]] [roguetv.macros [*]]) 2 | 3 | (import 4 | random 5 | [kodhy.util [T F ret]] 6 | roguetv.strings 7 | [roguetv.english [NounPhraseNamed]] 8 | [roguetv.globals :as G] 9 | [roguetv.util [*]] 10 | [roguetv.types [Drawable MapObject Scheduled]] 11 | [roguetv.map [Tile on-map mget room-for? outer-corner-pos circ-taxi disc-taxi]] 12 | [roguetv.item [Item]]) 13 | 14 | (defclass Creature [Drawable MapObject Scheduled NounPhraseNamed] [ 15 | escape-xml-in-np-format T 16 | char "C" 17 | info-text "[Missing info text]" 18 | 19 | can-open-doors F 20 | flying F 21 | slime-immune F 22 | web-immune F 23 | spook-immune F 24 | heavy F 25 | ; A heavy creature can't be pushed past by the player. 26 | 27 | __init__ (fn [self &optional pos] 28 | (MapObject.__init__ self pos) 29 | (Scheduled.__init__ self) 30 | (self.schedule) 31 | (self.reset-ice-slipping) 32 | None) 33 | 34 | get-info-text (fn [self] 35 | self.info-text) 36 | 37 | reset-ice-slipping (fn [self] 38 | (setv self.ice-slip-time 0) 39 | (setv self.ice-slip-towards None)) 40 | 41 | ice-immune (fn [self] 42 | F) 43 | 44 | can-see-contents (fn [self container-tile] 45 | (not container-tile.opaque-container)) 46 | 47 | visible-item-at (fn [self p] 48 | ; Returns 0 for being able to see there's no item, and None 49 | ; if the creature can't see whether there is one or not. 50 | ; N.B. This does *not* check whether the creature can see the 51 | ; tile in the first place. 52 | (setv t (Tile.at p)) 53 | (when (or (not t.container) (.can-see-contents self t)) 54 | (or (Item.at p) 0))) 55 | 56 | gettable-item-at (fn [self p] 57 | (and (not (. (Tile.at p) container)) (Item.at p))) 58 | 59 | information (fn [self] 60 | (.format "\n {} {:a}\n\n{}" 61 | (.xml-symbol self) 62 | self 63 | (.format (.get-info-text self) #** (. (type self) __dict__)))) 64 | 65 | take-time (fn [self duration] 66 | (.take-time Scheduled self duration) 67 | (when (and duration self.ice-slip-time) 68 | ; The creature takes some extra time slipping. 69 | (setv slip-time self.ice-slip-time) 70 | (msgp self "You take a moment to steady yourself on the ice.") 71 | (self.reset-ice-slipping) 72 | (.take-time self slip-time))) 73 | 74 | move (fn [self p-to &optional [clobber F]] 75 | (setv p-from self.pos) 76 | (MapObject.move self p-to clobber) 77 | (unless (none? self.pos) 78 | (.after-entering (Tile.at self.pos) self p-from))) 79 | 80 | walk-to (fn [self p-to] (block 81 | (setv p-from self.pos) 82 | (setv dist (.walk-dist self p-from p-to)) 83 | (unless (.bump-into (mget p-to) self) 84 | (ret F)) 85 | (when (player? self) 86 | (whenn (afind-or it.superheavy (active-inv)) 87 | (msg "You can't move an inch so long as you're clinging to {:the}." it) 88 | (ret F)) 89 | (when (not (on-map p-to)) 90 | ; If the player has an item that allows them to wrap 91 | ; around the map, apply it. 92 | (when (and (in p-to (outer-corner-pos)) 93 | (afind-or (or it.carry-mapwrap-eastwest it.carry-mapwrap-northsouth) (active-inv))) 94 | (msg 'tara "Please don't try to wrap through a corner of the dungeon, {p}. That could tear the spacetime continuum and destroy the universe.") 95 | (ret F)) 96 | (for [[pa item-attr max-coord d-neg d-pos] [ 97 | ["x" "carry_mapwrap_eastwest" G.map-width Pos.WEST Pos.EAST] 98 | ["y" "carry_mapwrap_northsouth" G.map-height Pos.SOUTH Pos.NORTH]]] 99 | (unless (and 100 | (in (getattr p-to pa) [-1 max-coord]) 101 | (afind-or (getattr it item-attr) (active-inv))) 102 | (continue)) 103 | (setattr p-to pa 104 | (if (= (getattr p-to pa) -1) (dec max-coord) 0)) 105 | (setv d (if (getattr p-to pa) d-neg d-pos)) 106 | (while T 107 | (when (room-for? self p-to) 108 | (break)) 109 | (+= p-to d) 110 | (when (= (getattr p-to pa) (getattr p-from pa)) 111 | (.take-time self (seconds (/ dist (self.walk-speed None)))) 112 | (msg 'tara "Looks like {p} doesn't have room to wrap around the level here.") 113 | (ret F)))))) 114 | (when (or 115 | (not (on-map p-to)) 116 | (and (. (Tile.at p-to) blocks-movement) 117 | (not (and (player? self) (or 118 | (.get-effect self Passwall) 119 | G.always-passwall))))) 120 | (when (and (player? self) (.get-effect self Confusion)) 121 | (msg "You bump into {:the}." (mget p-to)) 122 | (.take-time self self.confusion-bump-time)) 123 | (ret F)) 124 | (setv cr (Creature.at p-to)) 125 | ; The player can push past other creatures, but other creatures 126 | ; can't push past the player or each other. 127 | (when cr 128 | (unless (player? self) 129 | (ret F)) 130 | (when cr.heavy 131 | (msg 132 | (if (hallu) 133 | "A casual like you can't even handle {:a} right now." 134 | "You're far too puny to push past {:the}.") 135 | cr) 136 | (ret F)) 137 | (.take-time self self.push-past-monster-time)) 138 | ; Okay, we're clear to move. 139 | (.step-out-of (Tile.at p-from) self p-to) 140 | (.take-time self (seconds (/ dist (self.walk-speed p-to)))) 141 | ; Hence, a creature with walk-speed 1 takes 1 second to walk 142 | ; 1 unit of distance. 143 | (when cr 144 | (push-past-msg cr)) 145 | (.move self p-to :clobber T) 146 | (when cr 147 | (.move cr p-from)) 148 | (for [p (disc-taxi p-to G.spook-radius)] 149 | (when (and (. (mget p) spooky) (not self.spook-immune)) 150 | (.take-time self (.spook-time self)) 151 | (when (and (player? self) (not (. (mget p) player-noticed-spook))) 152 | (setv (. (mget p) player-noticed-spook) T) 153 | (msg "The hair on the back of your neck stands up.")))) 154 | (when (player? self) 155 | (rtv display.describe-tile self.pos)) 156 | (.after-step-onto (Tile.at p-to) self p-from) 157 | T)) 158 | 159 | get-effect (fn [self effect-cls] 160 | None) 161 | 162 | walk-dist (fn [self p-from p-to] 163 | (dist-taxi p-from p-to)) 164 | 165 | walk-speed (fn [self p-to] 166 | ; Return the applicable multiplier for the creature's walking 167 | ; speed. 168 | 1) 169 | 170 | spook-time (fn [self] 171 | (seconds (random.randint 1 (inc G.dungeon-level))))]) 172 | 173 | (defn push-past-msg [cr] 174 | (setv verb (if (hallu) 175 | (random.choice roguetv.strings.hallucinated-push-past-verbs) 176 | "push past")) 177 | (msg 178 | (if (in "{" verb) 179 | verb 180 | (+ "You " verb " {:the}.")) 181 | cr)) 182 | 183 | (defclass Effect [Scheduled] [ 184 | ; Despite that this class is in creature.generic instead of 185 | ; creature.player, only the player can have effects. 186 | 187 | queue-priority -2 188 | 189 | status "???" 190 | ; Text shown in the status bar. 191 | hallu-status "???" 192 | ; Text show in the status bar during hallucination. 193 | end-msg None 194 | 195 | __init__ (meth [duration] 196 | (@schedule) 197 | (@take-time duration) 198 | None) 199 | 200 | add-to-player (cmeth [duration start-msg lengthen-msg] 201 | (setv e (.get-effect G.player @@)) 202 | ; If the player already has an effect of this kind, 203 | ; the new duration is added to the old one. 204 | (if e 205 | (do 206 | (lengthen-msg) 207 | (.take-time e duration)) 208 | (do 209 | (start-msg) 210 | (.append G.player.effects (@@ duration))))) 211 | 212 | act (meth [] 213 | (@destroy)) 214 | 215 | destroy (meth [] 216 | (msg @end-msg) 217 | (.remove G.player.effects @@) 218 | (.destroy (super Effect @@)))]) 219 | 220 | (defclass Stink [Effect] [ 221 | status "PU" 222 | hallu-status "Ugly" 223 | end-msg "You smell presentable again."]) 224 | 225 | (defclass Haste [Effect] [ 226 | status "Fast" 227 | hallu-status "Sanic" 228 | end-msg "The rush of energy fades."]) 229 | 230 | (defclass Confusion [Effect] [ 231 | status "Conf" 232 | hallu-status "Tired" 233 | end-msg "Your mind clears."]) 234 | 235 | (defclass Strength [Effect] [ 236 | status "Str" 237 | hallu-status "FaZe" 238 | end-msg "You feel like a 98-pound weakling."]) 239 | ; Charles Atlas ads 240 | 241 | (defclass Passwall [Effect] [ 242 | status "Pass" 243 | hallu-status "Spooky" 244 | end-msg "You feel solid again." 245 | 246 | destroy (meth [] 247 | (.destroy (super Passwall @@)) 248 | (when (. (Tile.at G.player.pos) blocks-movement) 249 | (block 250 | ; Passwall just ended while the player was in a solid 251 | ; obstacle. Eject them to the nearest clear tile. 252 | (for [r (seq 1 (+ G.map-width G.map-height))] 253 | (for [p (shuffle (circ-taxi G.player.pos r))] 254 | (when (room-for? Creature p) 255 | (msg "As you materialize, you are ejected from {:the}." (Tile.at G.player.pos)) 256 | (.move G.player p) 257 | (ret)))) 258 | ; There's no room anywhere on the level! 259 | (msg 'tara "Oh no! Is {p:the} trapped inside {:the}?" (Tile.at G.player.pos)))))]) 260 | 261 | (defclass Hallucinating [Effect] [ 262 | status "Hallu" 263 | hallu-status "MLG" 264 | end-msg "Everything looks SO boring now."]) 265 | -------------------------------------------------------------------------------- /roguetv/creature/monster.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [amap filt afind-or whenn block λ meth]] [roguetv.macros [*]]) 2 | 3 | (import 4 | [random [choice]] 5 | pypaths.astar 6 | [heidegger.pos [Pos]] 7 | [kodhy.util [T F ret weighted-choice maxes]] 8 | [roguetv.english [NounPhrase]] 9 | [roguetv.globals :as G] 10 | [roguetv.util [*]] 11 | [roguetv.types [Scheduled CanBeHallucinated]] 12 | [roguetv.map [Tile Wall Floor Slime Web room-for? mget mset on-map disc-taxi in-los?]] 13 | [roguetv.item [Item drop-pos]] 14 | [roguetv.creature [Creature Stink]]) 15 | 16 | (defclass Monster [CanBeHallucinated Creature] [ 17 | ; A class for all non-player creatures. 18 | hallu-kind "monster" 19 | 20 | __init__ (fn [self &optional pos] 21 | (Creature.__init__ self pos) 22 | (CanBeHallucinated.__init__ self)) 23 | 24 | get-info-text (fn [self] 25 | (if (hallu) 26 | (. (.hallucinate self) info) 27 | (Creature.get-info-text self))) 28 | 29 | walk-to (fn [self p-to] 30 | (unless (.walk-to (super Monster self) p-to) 31 | (raise (ValueError (.format "{} tried to walk where it couldn't: {}" self p-to))))) 32 | 33 | player-repulsive? (fn [self] 34 | (or 35 | (.get-effect G.player Stink) 36 | (afind-or (instance? it.carry-repel-monster self) 37 | (filt it.carry-repel-monster (active-inv))))) 38 | 39 | flee-from-player (fn [self] (block 40 | ; If the player is repulsive to us and we're in range, try to 41 | ; run away (not very intelligently), and return T. 42 | ; Otherwise, return F. 43 | (unless (and 44 | (.player-repulsive? self) 45 | (<= (dist-taxi self.pos G.player.pos) G.repulsed-from-player-range)) 46 | (ret F)) 47 | (setv neighbors (sorted 48 | (shuffle (clear-neighbors self.pos)) 49 | :key (λ (, 50 | (- (/ (dist-taxi it G.player.pos) (dist-taxi it self.pos))) 51 | (dist-taxi it self.pos))))) 52 | (if (and neighbors (> 53 | (dist-taxi (first neighbors) G.player.pos) 54 | (dist-taxi self.pos G.player.pos))) 55 | (.walk-to self (first neighbors)) 56 | (.wait self)) 57 | T))]) 58 | 59 | (defn extant-monsters [] 60 | (filt (instance? Monster it) Scheduled.queue)) 61 | 62 | (defn clear-neighbors [pos] 63 | (filt (room-for? Creature it) 64 | (amap (+ pos it) Pos.DIR8))) 65 | 66 | (defn wander [cr &optional [okay? (λ T)]] (block 67 | ; Try to step in a random direction. (Diagonal moves are half 68 | ; as likely as orthogonal moves.) Return a boolean indicating 69 | ; whether we succeeded. 70 | (setv neighbors (filt (okay? it) (clear-neighbors cr.pos))) 71 | (unless neighbors 72 | (ret F)) 73 | (setv p-to (weighted-choice (amap 74 | (, (/ 1 (dist-taxi cr.pos it)) it) 75 | neighbors))) 76 | (.walk-to cr p-to) 77 | T)) 78 | 79 | (defn find-path [p-from p-to &optional [max-cost (int 1e6)]] (block 80 | (when (= p-from p-to) 81 | (ret [p-to])) 82 | (setv searcher (pypaths.astar.pathfinder 83 | :neighbors (fn [p] (+ (clear-neighbors p) 84 | (if (adjacent? p p-to) [p-to] []))) 85 | :distance dist-euclid 86 | ; This is the heuristic. Because the 2-norm ≤ the 1-norm, 87 | ; Euclidean distance is an admissible heuristic for taxicab 88 | ; geometry. 89 | :cost dist-taxi)) 90 | (cut (second (searcher p-from p-to max-cost)) 1))) 91 | 92 | (defn find-path-thru-creatures [p-from p-to &optional [max-cost (int 1e6)]] 93 | (setv searcher (pypaths.astar.pathfinder 94 | :neighbors (fn [p] (+ 95 | (filt (and (on-map it) (not (. (Tile.at it) blocks-movement))) 96 | (amap (+ p it) Pos.DIR8)) 97 | (if (adjacent? p p-to) [p-to] []))) 98 | :distance dist-euclid 99 | ; This is the heuristic. Because the 2-norm ≤ the 1-norm, 100 | ; Euclidean distance is an admissible heuristic for taxicab 101 | ; geometry. 102 | :cost (fn [p1 p2] 103 | ; Prefer paths that don't go through creatures. 104 | (when (or (none? p1) (none? p2)) 105 | (raise (ValueError [p1 p2 p-to]))) 106 | (+ (dist-taxi p1 p2) 107 | (* 2 (bool (and (Creature.at p2) (!= p2 p-to)))))))) 108 | (cut (second (searcher p-from p-to max-cost)) 1)) 109 | 110 | (defclass Bee [Monster] [ 111 | name (NounPhrase "bumblebee") 112 | char "a" 113 | color-fg :yellow 114 | info-text "A jolly little insect that buzzes about aimlessly. Your standard-issue contestant protective gear will protect you from stings. Bees can still kind of get in the way, though." 115 | 116 | flying T 117 | 118 | act (fn [self] 119 | (or 120 | (.flee-from-player self) 121 | (wander self) 122 | (.wait self)))]) 123 | 124 | (defclass Cat [Monster] [ 125 | name (NounPhrase "cat") 126 | char "f" 127 | color-fg :dark-orange 128 | info-text "A regal creature with little concern for you or your affairs. It moves when the mood strikes it, or to avoid dirtying its dainty paws." 129 | 130 | move-chance (/ 1 30) 131 | 132 | unpleasant? (fn [self pos] 133 | ; Check whether a tile has an unpleasant terrain or is in 134 | ; the range of a spooky tile. 135 | (or 136 | (. (Tile.at pos) unpleasant) 137 | (any (amap 138 | (. (Tile.at it) spooky) 139 | (disc-taxi pos G.spook-radius))))) 140 | 141 | act (fn [self] (block 142 | (when (.flee-from-player self) 143 | (ret)) 144 | ; Usually just sit there. Occasionally, wander in a random 145 | ; direction. Avoid unpleasant tiles. 146 | (unless (and 147 | (or (.unpleasant? self self.pos) 148 | (chance self.move-chance)) 149 | (or (wander self (λ (not (.unpleasant? self it)))) 150 | (wander self))) 151 | (.wait self))))]) 152 | 153 | (defclass Dog [Monster] [ 154 | name (NounPhrase "dog") 155 | char "d" 156 | color-fg :brown 157 | info-text "A clingy, fawning mongrel that will cheerfully chase you and get underfoot. Fortunately, it's not the sharpest cheese in the pantry." 158 | 159 | detect-player-range 12 160 | 161 | act (fn [self] (block 162 | (when (.flee-from-player self) 163 | (ret)) 164 | ; If the player is close, try to chase after them, not very 165 | ; intelligently. 166 | (setv d (- G.player.pos self.pos)) 167 | (when (<= (len-taxi d) self.detect-player-range) 168 | (when (= (len-cheb d) 1) 169 | ; We're adjacent. 170 | ; If we're orthogonally adjacent, just stay here. 171 | (when (= (len-taxi d) 1) 172 | (.wait self) 173 | (ret)) 174 | ; Otherwise, we're diagonally adjacent. If possible, move 175 | ; to be orthogonally adjacent. (In taxicab geometry, 176 | ; orthogonal is closer than diagonal.) 177 | (for [part (shuffle [(Pos d.x 0) (Pos 0 d.y)])] 178 | (setv p-to (+ part self.pos)) 179 | (when (room-for? Creature p-to) 180 | (.walk-to self p-to) 181 | (ret))) 182 | ; Otherwise, chill out. 183 | (.wait self) 184 | (ret)) 185 | ; If we have a path to the player, use it. 186 | (setv path (find-path-thru-creatures self.pos G.player.pos 187 | self.detect-player-range)) 188 | (when path 189 | (if (room-for? self (first path)) 190 | (.walk-to self (first path)) 191 | (.wait self)) 192 | (ret))) 193 | ; Otherwise, wander. 194 | (or (wander self) (.wait self))))]) 195 | 196 | (defclass Snail [Monster] [ 197 | name (NounPhrase "giant snail") 198 | char "S" 199 | color-fg :dark-green 200 | info-text "A mindless, oversized gastropod that slithers around the dungeon, leaving a trail of slime in its wake. It's very slow, but it isn't slowed any further by slime." 201 | 202 | walk-speed (meth [p-to] (/ 1 4)) 203 | slime-immune T 204 | 205 | act (meth [] 206 | (when (instance? Floor (Tile.at @pos)) 207 | (mset @pos (Slime))) 208 | (or 209 | (@flee-from-player) 210 | (wander @@) 211 | (@wait)))]) 212 | 213 | (defclass Spider [Monster] [ 214 | name (NounPhrase "giant spider") 215 | char "s" 216 | color-fg :red 217 | info-text "It doesn't bite, but it leaves webs wherever it goes." 218 | 219 | web-immune T 220 | 221 | act (meth [] 222 | (when (instance? Floor (Tile.at @pos)) 223 | (mset @pos (Web))) 224 | (or 225 | (@flee-from-player) 226 | (wander @@) 227 | (@wait)))]) 228 | 229 | (defclass Golem [Monster] [ 230 | name (NounPhrase "golem") 231 | char "g" 232 | color-fg :brown 233 | info-text "A massive clay humanoid given a semblance of life by magic. It's very slow and it moves in a fixed pattern, but it's too heavy to push past." 234 | 235 | walk-speed (meth [p-to] (/ 1 5)) 236 | change-dir-time (seconds 2) 237 | heavy T 238 | spook-immune T 239 | 240 | __init__ (meth [&optional pos] 241 | (.__init__ (super Golem @@) pos) 242 | (setv @dir None) 243 | None) 244 | 245 | act (meth [] 246 | ; The usual call to @flee-from-player is omitted on purpose. 247 | ; Golems do not know fear. 248 | ; 249 | ; If we have no direction set, choose the orthogonal 250 | ; direction we can walk the farthest in. 251 | (unless @dir 252 | (setv @dir (first (maxes (shuffle Pos.ORTHS) (λ 253 | (setv n 1) 254 | (while (room-for? @@ (+ @pos (* n it))) 255 | (+= n 1)) 256 | n))))) 257 | ; If we have room, walk forward. Otherwise, turn around. 258 | ; (When trapped, we'll just spend all our time turning back 259 | ; and forth.) 260 | (if (room-for? @@ (+ @pos @dir)) 261 | (@walk-to (+ @pos @dir)) 262 | (do 263 | (setv @dir (* -1 @dir)) 264 | (@take-time @change-dir-time))))]) 265 | 266 | (defclass UmberHulk [Monster] [ 267 | name (NounPhrase "umber hulk") 268 | char "U" 269 | color-fg :brown 270 | info-text "This creature is large and looks monstrous, like a giant bipedal insect, but what it hungers for is earth and stone. It wanders around gobbling up walls, hopefully creating some passages that are useful to you." 271 | 272 | dig-time (seconds 5) 273 | 274 | act (meth [] (block 275 | (when (@flee-from-player) 276 | (ret)) 277 | (for [d (shuffle Pos.ORTHS)] 278 | (setv p (+ @pos d)) 279 | (when (and (instance? Wall (mget p)) (none? (Creature.at p))) 280 | (mset p (Floor)) 281 | (@take-time @dig-time) 282 | (@walk-to p) 283 | (ret))) 284 | (or (wander @@) (@wait))))]) 285 | 286 | (defclass Nymph [Monster] [ 287 | name (NounPhrase "nymph") 288 | gender :female 289 | char "n" 290 | color-fg :dark-green 291 | info-text "A primal spirit of the forest disguised as a comely young woman. Nymphs are infatuated with man-made objects and have no compunctions about stealing, which makes sense when you consider that the typical nymph has lived in the woods for 800 years with no human contact until being dumped onto the set of a game show. Fortunately, they can only carry one thing at a time, and they tend to quickly lose interest in the objects they acquire." 292 | 293 | detect-item-range 8 294 | take-item-time (seconds 1) 295 | drop-item-time (seconds 1) 296 | 297 | __init__ (meth [&optional pos item] 298 | (.__init__ (super Nymph @@) pos) 299 | (setv @item None) 300 | (when item 301 | (@get-item item)) 302 | (setv @interested-in-item-till (dict)) 303 | None) 304 | 305 | get-item (meth [item] 306 | (setv @item item) 307 | (setv (get @interested-in-item-till item) 308 | (+ G.current-time (randexp-dl-div 3)))) 309 | 310 | item-attractive? (meth [item] 311 | (or 312 | (not-in item @interested-in-item-till) 313 | (< G.current-time (get @interested-in-item-till item)))) 314 | 315 | act (meth [] (block 316 | (when (@flee-from-player) 317 | (ret)) 318 | (when (and @item (not (@item-attractive? @item))) 319 | ; We've gotten bored with this item. Drop it if we can. 320 | (whenn (drop-pos @pos) 321 | (@take-time @drop-item-time) 322 | (.move @item it) 323 | (when (seen @pos) 324 | (msg "{:The} drops {:a}." @@ @item)) 325 | (setv @item None) 326 | (ret))) 327 | ; If we don't have an item, and there's an item we're not 328 | ; bored with (on the floor or in the player's inventory) in 329 | ; range that we can see, go to it. 330 | (when (not @item) 331 | (setv ps 332 | (sorted :key (λ (len (second it))) 333 | (shuffle 334 | (filt (second it) 335 | (amap (, it 336 | (find-path @pos it @detect-item-range)) 337 | (filter (fn [p] (and 338 | (or 339 | (whenn (@gettable-item-at p) (and it (@item-attractive? it))) 340 | (and (= p G.player.pos) (not (@player-repulsive?)) 341 | (afind-or (@item-attractive? it) G.inventory))) 342 | (in-los? @pos p))) 343 | (disc-taxi @pos @detect-item-range))))))) 344 | (when ps 345 | (setv [dest path] (first ps)) 346 | (cond 347 | [(= dest @pos) (do 348 | ; Pick up the item here. 349 | (@take-time @take-item-time) 350 | (@get-item (Item.at @pos)) 351 | (.move @item None) 352 | (when (seen @pos) 353 | (msg "{:The} picks up {:a}." @@ @item)))] 354 | [(and 355 | (= dest G.player.pos) 356 | (not (@player-repulsive?)) 357 | (= (dist-cheb @pos dest) 1) 358 | (afind-or (@item-attractive? it) G.inventory)) (do 359 | ; We're adjacent to the player, and they have something 360 | ; we want. Steal it. 361 | (@take-time @take-item-time) 362 | (@get-item (choice (filt (@item-attractive? it) G.inventory))) 363 | (.remove G.inventory @item) 364 | (msg "{:The} stole {:your}." @@ @item))] 365 | [(room-for? @@ (first path)) 366 | ; We have a usable path to an item. Take the next step. 367 | (@walk-to (first path))] 368 | [T 369 | (@wait)]) 370 | (ret))) 371 | ; Otherwise, wander. 372 | (or (wander @@) (@wait))))]) 373 | -------------------------------------------------------------------------------- /roguetv/creature/player.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [amap afind-or]]) 2 | 3 | (import 4 | [kodhy.util [T F ret product]] 5 | [roguetv.globals :as G] 6 | [roguetv.util [*]] 7 | [roguetv.input [get-normal-command]] 8 | [roguetv.map [Tile]] 9 | [roguetv.creature [Creature Haste]] 10 | [roguetv.display [full-redraw]] 11 | [roguetv.actions [do-normal-command]]) 12 | 13 | (defclass Player [Creature] [ 14 | queue-priority -1 15 | 16 | char "@" 17 | color-bg :yellow 18 | info-text "Applying state-of-the-art neuroludological algorithms to the choices you've made while playing this game, I've inferred the following about you:\n\nYou have a great need for other people to like and admire you. You have a tendency to be critical of yourself. You have a great deal of unused capacity which you have not turned to your advantage. While you have some personality weaknesses, you are generally able to compensate for them. Your sexual adjustment has presented problems for you. Disciplined and self-controlled outside, you tend to be worrisome and insecure inside. At times you have serious doubts as to whether you have made the right decision or done the right thing. You prefer a certain amount of change and variety and become dissatisfied when hemmed in by restrictions and limitations. You pride yourself as an independent thinker and do not accept others' statements without satisfactory proof. You have found it unwise to be too frank in revealing yourself to others." 19 | ; Forer, B. R. (1949). The fallacy of personal validation: A classroom demonstration of gullibility. Journal of Abnormal Psychology, 44(1), 118–123. doi:10.1037/h0059240 20 | 21 | can-open-doors T 22 | 23 | push-past-monster-time (seconds 1) 24 | confusion-bump-time (seconds 1) 25 | take-item-time (seconds 1) 26 | drop-item-time (seconds 1) 27 | 28 | __init__ (fn [self &optional pos] 29 | (Creature.__init__ self pos) 30 | (setv self.effects []) 31 | (setv self.just-slept F) 32 | (setv self.last-turn 0) 33 | None) 34 | 35 | ice-immune (fn [self] 36 | (afind-or it.carry-ice-immunity (active-inv))) 37 | 38 | move (fn [self p-to &optional [clobber F]] 39 | (.move (super Player self) p-to clobber) 40 | (soil-fov)) 41 | 42 | walk-dist (fn [self p-from p-to] 43 | (if (afind-or it.carry-cheb-walk (active-inv)) 44 | (dist-cheb p-from p-to) 45 | (.walk-dist (super Player self) p-from p-to))) 46 | 47 | walk-speed (fn [self p-to] 48 | (if G.super-speed 1e6 (product (+ 49 | (amap (or it.carry-speed-factor 1) (active-inv)) 50 | (amap 51 | (or 52 | (if (and p-to (. (Tile.at p-to) smooth)) 53 | it.carry-speed-factor-smooth-terrain 54 | it.carry-speed-factor-rough-terrain) 55 | 1) 56 | (active-inv)) 57 | [(if (.get-effect self Haste) 58 | G.haste-factor 59 | 1)])))) 60 | 61 | act (fn [self] 62 | (when self.just-slept 63 | (setv self.just-slept F) 64 | (msg "You wake up.")) 65 | (setv G.last-action-duration 66 | (- G.current-time self.last-turn)) 67 | (full-redraw) 68 | (setv self.last-turn G.current-time) 69 | (do-normal-command (get-normal-command))) 70 | 71 | get-effect (fn [self effect-cls] 72 | (afind-or (instance? effect-cls it) self.effects)) 73 | 74 | fall-asleep (fn [self sleep-time] 75 | (.take-time self sleep-time) 76 | (setv self.just-slept T))]) 77 | -------------------------------------------------------------------------------- /roguetv/display.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [lc amap fmap afind-or whenn]] [roguetv.macros [*]]) 2 | 3 | (import 4 | random 5 | [math [floor ceil]] 6 | textwrap 7 | curses 8 | [heidegger.pos [Pos]] 9 | [kodhy.util [T F concat]] 10 | roguetv.strings 11 | [roguetv.globals :as G] 12 | [roguetv.util [*]] 13 | [roguetv.input [look-at-keys]] 14 | [roguetv.types [Drawable MapObject]] 15 | [roguetv.map [Tile Floor]] 16 | [roguetv.fov [recompute-fov]] 17 | [roguetv.item [Item]] 18 | [roguetv.creature [Creature]] 19 | [roguetv.attrstr [AttrStr get-color curses-encode]]) 20 | 21 | (defn addstr [a1 &optional a2 a3 a4] 22 | (try 23 | (cond 24 | [(not (none? a4)) 25 | (G.T.addstr a1 a2 (curses-encode a3) a4)] 26 | [(not (none? a3)) 27 | (G.T.addstr a1 a2 (curses-encode a3))] 28 | [(not (none? a2)) 29 | (G.T.addstr (curses-encode a1) a2)] 30 | [T 31 | (G.T.addstr (curses-encode a1))]) 32 | (except [curses.error] None))) 33 | ; http://bugs.python.org/issue8243 34 | 35 | (defn echo [str color-fg color-bg] 36 | (addstr str (get-color color-fg color-bg))) 37 | 38 | (defn echo-drawable [d] 39 | (echo (.get-char d) (.get-color-fg d) (.get-color-bg d))) 40 | 41 | ; The functions `tx->px` and `ty->py` map terminal coordinates to 42 | ; Pos (map coordinates). They center the view on the focus 43 | ; position (usually the player's position) except when the focus 44 | ; is near the edge of the map, in which case they only scroll 45 | ; `G.map-border-width` units off the map, so as not to waste 46 | ; screen real estate. 47 | (defn tx->px [tx focus-px] 48 | (setv left (- focus-px (// G.screen-width 2))) 49 | (setv right (+ focus-px (// G.screen-width 2))) 50 | (cond 51 | [(>= G.screen-width (+ G.map-width (* 2 G.map-border-width))) 52 | (+ tx (- (// G.map-width 2) (// G.screen-width 2)))] 53 | [(< left (- G.map-border-width)) 54 | (- tx G.map-border-width)] 55 | [(>= right (+ G.map-border-width G.map-width)) 56 | (+ tx G.map-border-width G.map-width (- G.screen-width))] 57 | [T 58 | (+ (- tx (// G.screen-width 2)) focus-px)])) 59 | (defn ty->py [ty focus-py] 60 | (-= focus-py (int (ceil (/ G.bottom-border 2)))) 61 | ; Adjust the focus so the player usually appears centered. 62 | (setv bottom (- focus-py (// G.screen-height 2))) 63 | (setv top (+ focus-py (// G.screen-height 2))) 64 | (cond 65 | [(>= G.screen-height (+ G.map-height (* 2 G.map-border-width) G.bottom-border)) 66 | (- (+ (// G.map-height 2) (// (- G.screen-height G.bottom-border) 2)) ty)] 67 | [(< bottom (- (+ G.map-border-width G.bottom-border))) 68 | (- G.screen-height 1 G.map-border-width G.bottom-border ty)] 69 | [(>= top (+ G.map-border-width G.map-height)) 70 | (- (+ G.map-height G.map-border-width) 1 ty)] 71 | [T 72 | (+ (- (// G.screen-height 2) ty) focus-py)])) 73 | 74 | (defn draw-map [focus ty-min ty-max] 75 | (when G.fov-dirty? 76 | (recompute-fov) 77 | (setv G.fov-dirty? F)) 78 | (G.T.move 0 ty-min) 79 | (for [ty (seq ty-min ty-max)] 80 | (setv py (ty->py ty focus.y)) 81 | (for [tx (range G.screen-width)] 82 | (setv px (tx->px tx focus.x)) 83 | (when (= (Pos px py) focus) 84 | (setv focus-t-coords [ty tx])) 85 | (cond 86 | [(not (and (<= 0 px (dec G.map-width)) (<= 0 py (dec G.map-height)))) 87 | ; Off the map. 88 | (echo " " G.fg-color G.off-map-color)] 89 | [(get G.seen-map px py) 90 | ; Seen by the player. 91 | (echo-drawable (do (setv p (Pos px py)) (or 92 | (Creature.at p) 93 | (.visible-item-at G.player p) 94 | (Tile.at p))))] 95 | [T 96 | ; Unseen. 97 | (echo " " G.fg-color G.unseen-color)]))) 98 | focus-t-coords) 99 | 100 | (defn draw-status-line [] 101 | (setv time-left (max 0 (- (or G.time-limit 0) G.current-time))) 102 | (setv time-left-frac (/ time-left (dl-time-limit G.dungeon-level))) 103 | (setv s (AttrStr.from-xml 104 | (.format "{} {} {} DL:{: 2} {:>6}{} {}" 105 | (color-xml 106 | (do (setv w (* G.time-bar-width time-left-frac)) (cat 107 | (* (get G.time-bar-chunk-chars -1) (int (floor w))) 108 | (when (% w 1) (get G.time-bar-chunk-chars (int (round 109 | (* (% w 1) (dec (len G.time-bar-chunk-chars))))))) 110 | (* (get G.time-bar-chunk-chars 0) (- G.time-bar-width (int (ceil w)))))) 111 | None 112 | (whenn (afind-or (<= time-left-frac (first it)) G.time-warnings) 113 | (second it))) 114 | (.rjust (minsec time-left) (len "10:00")) 115 | (.ljust 116 | (if G.last-action-duration 117 | (.format "({})" (show-round 118 | (/ G.last-action-duration G.clock-factor) 119 | 3)) 120 | "") 121 | (len "(1.151)")) 122 | (inc G.dungeon-level) 123 | (+ "$" (string (sum 124 | (fmap (.apparent-price it) (numeric? (.apparent-price it)) G.inventory)))) 125 | (if (afind-or (not (.identified? it)) G.inventory) 126 | " + ?" 127 | " ") 128 | (.join " " (amap (if (hallu) it.hallu-status it.status) G.player.effects))))) 129 | (G.T.move (- G.screen-height 1 G.message-lines) 0) 130 | (.draw (.trunc s G.screen-width))) 131 | 132 | (defn draw-message-log [&optional [fullscreen F]] 133 | (when fullscreen 134 | (G.T.erase)) 135 | (setv height (if fullscreen G.screen-height G.message-lines)) 136 | (setv lines (concat 137 | (lc [[mn [count text-xml]] (cut (list (enumerate G.message-log)) (- height))] 138 | (amap (, mn count it) (.wrap 139 | (AttrStr.from-xml (cat text-xml (when (> count 1) 140 | (.format " [× {}]" count)))) 141 | G.screen-width))))) 142 | (setv lines (cut lines (- height))) 143 | (for [[i [mn count astr]] (enumerate lines)] 144 | (G.T.move (+ i (- G.screen-height height)) 0) 145 | (.draw astr (if (or 146 | (> mn G.last-new-message-number) 147 | (and (= mn G.last-new-message-number) 148 | (> count G.last-message-count))) 149 | G.new-msg-highlight 150 | 0)))) 151 | 152 | (defn full-redraw [&optional focus] 153 | (G.T.erase) 154 | (setv focus-t-coords (draw-map 155 | :focus (or focus G.player.pos) 156 | :ty-min 0 157 | :ty-max (if (= G.screen-mode :normal) 158 | (dec (- G.screen-height G.bottom-border)) 159 | (dec G.screen-height)))) 160 | (when (= G.screen-mode :normal) 161 | (draw-status-line) 162 | (draw-message-log) 163 | (curses.curs-set 0)) 164 | (when (= G.screen-mode :look) 165 | (draw-look-legend focus) 166 | (curses.curs-set 1) 167 | (G.T.move #* focus-t-coords)) 168 | (G.T.refresh)) 169 | 170 | (defn render-text-screen [text-xml] 171 | (curses.curs-set 0) 172 | (setv w (- G.screen-width G.text-screen-left-margin)) 173 | (setv lines (concat (amap 174 | (if it (.wrap (AttrStr.from-xml it) w) [(AttrStr)]) 175 | (.split text-xml "\n")))) 176 | (setv pages []) 177 | (setv i 0) 178 | (while T 179 | (.append pages {"text" (cut lines i (+ i G.screen-height))}) 180 | (when (>= (+ i G.screen-height) (len lines)) 181 | (break)) 182 | ; Remove the bottom line to make room for a "more" prompt. 183 | (setv (get pages -1 "text") (cut (get pages -1 "text") None -1)) 184 | (setv (get pages -1 "more") T) 185 | (+= i (+ G.screen-height -1 (- G.text-screen-page-overlap)))) 186 | pages) 187 | 188 | (defn draw-text-screen-page [page] 189 | (G.T.erase) 190 | (for [[i line] (enumerate (get page "text"))] 191 | (G.T.move i G.text-screen-left-margin) 192 | (.draw line)) 193 | (when (.get page "more") 194 | (G.T.move (len (get page "text")) 0) 195 | (.draw (AttrStr.from-xml (color-xml "-- more --" G.bg-color G.fg-color))))) 196 | 197 | (defn draw-inventory [prompt] 198 | (setv item-sort-order (list (enumerate [ 199 | (get G.itypes "aoy") 200 | (rtv-get item.burden.Burden) 201 | (rtv-get item.clothing.Clothing) 202 | (rtv-get item.gadget.Gadget) 203 | (rtv-get item.soda.Soda) 204 | (rtv-get item.gadget.Battery)]))) 205 | (.sort G.inventory :key (fn [item] (if (hallu) (.lower (.format "{}" item)) (do 206 | (setv category (afind-or (instance? (second it) item) item-sort-order)) 207 | (setv category (if category (first category) (len item-sort-order))) 208 | (, 209 | category 210 | (.lower (.format "{}" item)) 211 | (not (.identified? item)) 212 | (when (and (hasattr item "charges") (.identified? item)) 213 | (- item.charges)) 214 | (when (hasattr item "boxed") 215 | item.boxed) 216 | item.curse 217 | item.invlet))))) 218 | (setv names (amap (.format "{:a:most}" it) G.inventory)) 219 | (setv prices (amap (.apparent-price it) G.inventory)) 220 | (when (hallu) 221 | (setv prompt (.format "What do you want to {}?" 222 | (random.choice roguetv.strings.hallucinated-item-verbs)))) 223 | (setv lines (amap (AttrStr.from-xml it) (+ 224 | [prompt] 225 | (amap 226 | (.format " {} {} {:{}} {}{:>{}}" 227 | (. (get G.inventory it) invlet) 228 | (.xml-symbol (get G.inventory it)) 229 | (get names it) 230 | (max (map len names)) 231 | (if (zero? it) "$" " ") 232 | (get prices it) 233 | (max (amap (len (string it)) prices))) 234 | (range (len G.inventory))) 235 | (* [" ---"] (- G.inventory-limit (len G.inventory)))))) 236 | (setv width (min G.screen-width (inc (max (map len lines))))) 237 | (for [[n line] (enumerate lines)] 238 | (G.T.move n 0) 239 | (.draw (.ljust line width)))) 240 | 241 | (defn draw-look-legend [p] 242 | ; In look mode, show a legend describing the creature, item, 243 | ; and tile under the cursor. 244 | (setv dunno (unless (seen p) " ? unseen")) 245 | (setv lines [ 246 | "At cursor: (press a key to examine)" 247 | (or dunno (whenn (Creature.at p) 248 | (.format " {} {} {:a}" (get look-at-keys :creature) (.xml-symbol it) it))) 249 | (or dunno 250 | (when (none? (.visible-item-at G.player p)) 251 | " ? can't tell") 252 | (whenn (Item.at p) 253 | (.format " {} {} {:a:full}" (get look-at-keys :item) (.xml-symbol it) it))) 254 | (or dunno 255 | (.format " {} {} {:a:full}" (get look-at-keys :tile) (.xml-symbol (Tile.at p)) (Tile.at p)))]) 256 | (setv lines (amap (AttrStr.from-xml (or it " ---")) lines)) 257 | (assert (= (len lines) G.look-mode-legend-height)) 258 | (setv width (min G.screen-width (inc (max (map len lines))))) 259 | (for [[n line] (enumerate lines)] 260 | (G.T.move (- G.screen-height (- (len lines) n)) 0) 261 | (.draw (.ljust line width)))) 262 | 263 | (defn describe-tile [pos &optional verbose] 264 | (setv tile (Tile.at pos)) 265 | (cond 266 | [(.visible-item-at G.player pos) (do 267 | (msg "You see here {} {:a:full}." (.xml-symbol (Item.at pos)) (Item.at pos)) 268 | (unless (instance? Floor tile) 269 | ; This triggers even when 'verbose' is false because 270 | ; there's an item covering this tile, so the tile type 271 | ; may not be obvious. 272 | (msg "There is also {} {:a:full} here." (.xml-symbol tile) tile)))] 273 | [verbose 274 | (if (instance? Floor tile) 275 | (msg 'bob "Now the beetle-headed {} is snilching the floor. Wonder what {p:he's} looking for." 276 | (if (G.player.name.female) "dowdy" "cull")) 277 | (msg "There is {} {:a:full} here." (.xml-symbol tile) tile))])) 278 | -------------------------------------------------------------------------------- /roguetv/english.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [amap afind-or block qw]] [roguetv.macros [*]]) 2 | 3 | (import 4 | xml.sax.saxutils 5 | inflect 6 | [kodhy.util [T F ret ucfirst]]) 7 | 8 | (def -inflect (inflect.engine)) 9 | 10 | (def -pronoun-d ((fn [] 11 | (setv table [ 12 | [ :singular-they :male :female :neuter :s1 :p1 :s2 :p2 :p3] 13 | (qw they he she it I we you you they) 14 | (qw them him her it me us you your them) 15 | (qw their his her its my our your your their) 16 | (qw theirs his hers its mine ours yours yours theirs) 17 | (qw themself himself herself itself myself ourselves yourself yourselves themselves) 18 | (qw they’re he’s she’s it’s I’m we’re you’re you’re they’re) 19 | (qw they’ll he’ll she’ll it’ll I’ll we’ll you’ll you’ll they’ll) 20 | (qw they’ve he’s she’s it’s I’ve we’ve you’ve you’ve they’ve) 21 | (qw they’d he’d she’d it_had I’d we’d you’d you’d they’d)]) 22 | ; We only used smart quotes here because "'" can't be in a Hy 23 | ; identifier. Similarly, we used underscores in place of spaces. 24 | ; Switch them back. 25 | (for [row (rest table)] 26 | (setv (cut row) (amap (.replace (.replace it "’" "'") "_" " ") row))) 27 | ; Set 'd' to a dictionary mapping the :singular-they forms 28 | ; to dictionaries of all forms for that part of speech. 29 | (setv cols (first table)) 30 | (setv d (dict (amap 31 | (, (first it) (dict (zip cols it))) 32 | (rest table)))) 33 | ; Also allow using masculine pronouns as keys into 'd'. 34 | (for [v (list (.values d))] 35 | (setv (get d (get v :male)) v)) 36 | ; "His" is ambiguous. Handle it by making "his" always maps to 37 | ; "their" and providing "hers" for "theirs". 38 | (setv (get d "his") (get d "their")) 39 | (setv (get d "hers") (get d "theirs")) 40 | ; "He's" is also ambiguous. Handle it by making "he's" always 41 | ; maps to "they're". This time, the feminine form doesn't help, 42 | ; so you must use "they've" if you want "I've" etc. 43 | (setv (get d "he's") (get d "they're")) 44 | ; Finally, create capitalized forms of everything. 45 | (for [[k v] (list (.items d))] 46 | (setv (get d (ucfirst k)) (dict (zip 47 | (.keys v) 48 | (amap (ucfirst it) (.values v)))))) 49 | d))) 50 | 51 | (def genders (, :male :female :neuter :singular-they)) 52 | (def pronoun-bases (frozenset (.keys -pronoun-d))) 53 | 54 | (defn pronoun [base &optional [gender :neuter] [person 3] [plural F]] 55 | ; Inflect the pronoun 'base' using 'gender', 'person', and 'plural'. 56 | (get -pronoun-d base (get 57 | (if plural [:p1 :p2 :p3] [:s1 :s2 gender]) 58 | (dec person)))) 59 | 60 | (defn verb [base &optional [gender :neuter] [person 3] [plural F]] 61 | ; The 'base' should be in 3rd-person singular form 62 | ; (e.g., "is", "was", "does", "did", "swims"). 63 | (when (= gender :singular-they) 64 | ; The pronoun requires a plural form, but the original noun 65 | ; might be singular. We can't tell which is which. 66 | (raise (ValueError "Inflecting a verb for a :singular-they subject is ambiguous"))) 67 | (cond 68 | [(and (= base "is") (= person 1) (not plural)) 69 | "am"] 70 | [(and (= base "was") (= person 1) (not plural)) 71 | "was"] 72 | [(and (= person 3) (!= gender :singular-they) (not plural)) 73 | base] 74 | [T 75 | (.plural-verb -inflect base)])) 76 | 77 | (defclass NounPhrase [object] [ 78 | 79 | __init__ (fn [self stem &optional 80 | plural 81 | [gender :neuter] 82 | article 83 | [mass F] 84 | [always-plural F] 85 | unit 86 | [bare-proper F] 87 | [the-proper F]] (block 88 | 89 | (when (instance? NounPhrase stem) 90 | ; Just clone. 91 | (setv self.__dict__ stem.__dict__) 92 | (ret)) 93 | 94 | (when (or 95 | (not (in gender genders)) 96 | (and (or mass always-plural) (not unit)) 97 | (and unit (not (or mass always-plural))) 98 | (and always-plural plural) 99 | (and always-plural bare-proper)) 100 | (raise (ValueError (+ "Bad NounPhrase parameters: " stem)))) 101 | 102 | (setv united (when unit 103 | (.format "{} of {}{}" unit (if the-proper "the " "") stem))) 104 | (setv pluralized (cond 105 | [(or always-plural mass) 106 | (if the-proper united stem)] 107 | [plural 108 | plural] 109 | [T 110 | ; Work around https://github.com/pwdyson/inflect.py/issues/40 111 | (setv [a b c] (.partition stem " of ")) 112 | (+ (.plural-noun -inflect a) b c)])) 113 | 114 | (setv definite-singular 115 | (if bare-proper stem (+ "the " stem))) 116 | (setv definite-plural 117 | (+ "the " pluralized)) 118 | (setv indefinite-singular 119 | (cond 120 | [(or bare-proper the-proper) 121 | definite-singular] 122 | [(or mass always-plural) 123 | (+ "some " stem)] 124 | [article 125 | (+ article " " stem)] 126 | [T 127 | (.a -inflect stem)])) 128 | (setv indefinite-plural 129 | (+ "some " pluralized)) 130 | (setv your 131 | (if (or bare-proper the-proper) definite-singular (+ "your " stem))) 132 | (setv count 133 | (if unit united pluralized)) 134 | 135 | (set-self 136 | stem gender mass always-plural 137 | definite-singular definite-plural indefinite-singular indefinite-plural your count) 138 | None)) 139 | 140 | __format__ (fn [self formatstr] 141 | (setv upper (not (none? (afind-or (.isupper it) formatstr)))) 142 | (setv formatstr (.lower formatstr)) 143 | ((if upper ucfirst identity) (cond 144 | [(in formatstr pronoun-bases) 145 | (pronoun formatstr 146 | :gender self.gender 147 | :plural self.always-plural)] 148 | [(.startswith formatstr "v:") 149 | (verb (cut formatstr (len "v:")) 150 | :gender self.gender 151 | :plural self.always-plural)] 152 | [(.startswith formatstr "p-v:") 153 | (verb (cut formatstr (len "p-v:")) 154 | :gender self.gender 155 | :plural (not self.mass))] 156 | [T 157 | (get 158 | { 159 | "" self.stem 160 | "the" self.definite-singular 161 | "p-the" self.definite-plural 162 | "a" self.indefinite-singular 163 | "some" self.indefinite-plural 164 | "your" self.your 165 | "num" self.count} 166 | formatstr)]))) 167 | 168 | female (fn [self] 169 | (= self.gender :female))]) 170 | 171 | (defclass NounPhraseNamed [object] [ 172 | name None 173 | escape-xml-in-np-format F 174 | 175 | escape (classmethod (fn [self s] 176 | (if (and s self.escape-xml-in-np-format) 177 | (xml.sax.saxutils.escape s) 178 | s))) 179 | 180 | get-name (fn [self] 181 | self.name) 182 | 183 | __format__ (fn [self formatstr] 184 | (.escape self (.__format__ (.get-name self) formatstr)))]) 185 | 186 | (defn english-list [l] 187 | (.join -inflect l)) 188 | -------------------------------------------------------------------------------- /roguetv/fov.py: -------------------------------------------------------------------------------- 1 | # encoding: UTF-8 2 | 3 | class FOVMap(object): 4 | # Originally from http://www.roguebasin.com/index.php?title=Python_shadowcasting_implementation 5 | # by Björn Bergström and Eric Burgess. 6 | # Multipliers for transforming coordinates to other octants: 7 | mult = [ 8 | [1, 0, 0, -1, -1, 0, 0, 1], 9 | [0, 1, -1, 0, 0, -1, 1, 0], 10 | [0, 1, 1, 0, 0, -1, -1, 0], 11 | [1, 0, 0, 1, -1, 0, 0, -1] 12 | ] 13 | def __init__(self, tile_omap): 14 | self.tile_omap = tile_omap 15 | self.width, self.height = len(tile_omap), len(tile_omap[0]) 16 | self.light = [] 17 | for i in range(self.width): 18 | self.light.append([0] * self.height) 19 | self.flag = 0 20 | def blocked(self, x, y): 21 | return (x < 0 or y < 0 22 | or x >= self.width or y >= self.height 23 | or self.tile_omap[x][y].blocks_sight) 24 | def lit(self, x, y): 25 | return self.light[x][y] == self.flag 26 | def set_lit(self, x, y): 27 | if 0 <= x < self.width and 0 <= y < self.height: 28 | self.light[x][y] = self.flag 29 | def _cast_light(self, cx, cy, row, start, end, radius, xx, xy, yx, yy): 30 | "Recursive lightcasting function" 31 | if start < end: 32 | return 33 | for j in range(row, radius+1): 34 | dx, dy = -j-1, -j 35 | blocked = False 36 | while dx <= 0: 37 | dx += 1 38 | # Translate the dx, dy coordinates into map coordinates: 39 | X, Y = cx + dx * xx + dy * xy, cy + dx * yx + dy * yy 40 | # l_slope and r_slope store the slopes of the left and right 41 | # extremities of the square we're considering: 42 | l_slope, r_slope = (dx-0.5)/(dy+0.5), (dx+0.5)/(dy-0.5) 43 | if start < r_slope: 44 | continue 45 | elif end > l_slope: 46 | break 47 | else: 48 | # Our light beam is touching this square; light it: 49 | if abs(dx) + abs(dy) < radius: 50 | self.set_lit(X, Y) 51 | if blocked: 52 | # we're scanning a row of blocked squares: 53 | if self.blocked(X, Y): 54 | new_start = r_slope 55 | continue 56 | else: 57 | blocked = False 58 | start = new_start 59 | else: 60 | if self.blocked(X, Y) and j < radius: 61 | # This is a blocking square, start a child scan: 62 | blocked = True 63 | self._cast_light(cx, cy, j+1, start, l_slope, 64 | radius, xx, xy, yx, yy) 65 | new_start = r_slope 66 | # Row is scanned; do next row unless last square was blocked: 67 | if blocked: 68 | break 69 | def do_fov(self, x, y, radius): 70 | "Calculate lit squares from the given location and radius" 71 | radius += 1 72 | # Thus, a radius value of N means you can see N 73 | # units away orthogonally (rather than N - 1 units). 74 | self.flag += 1 75 | self.set_lit(x, y) 76 | for octant in range(8): 77 | self._cast_light(x, y, 1, 1.0, 0.0, radius, 78 | self.mult[0][octant], self.mult[1][octant], 79 | self.mult[2][octant], self.mult[3][octant]) 80 | 81 | fovmap = None 82 | def init_fov_map(tile_omap): 83 | global fovmap 84 | fovmap = FOVMap(tile_omap) 85 | 86 | def recompute_fov(): 87 | import roguetv.globals as G 88 | fovmap.do_fov(G.player.pos.x, G.player.pos.y, G.vision_radius) 89 | for x in range(G.map_width): 90 | for y in range(G.map_height): 91 | if G.omnivision or fovmap.lit(x, y): 92 | G.seen_map[x][y] = True 93 | -------------------------------------------------------------------------------- /roguetv/globals.hy: -------------------------------------------------------------------------------- 1 | (import 2 | curses) 3 | 4 | (def globals-to-save (set)) 5 | (defmacro defs [varname value] 6 | ; Define a variable and mark it to be saved. 7 | (import [hy [HyString]]) 8 | `(do 9 | (def ~varname ~value) 10 | (.add globals-to-save ~(HyString varname)))) 11 | 12 | ;; * Parameters 13 | 14 | (def debug False) 15 | (def omnivision False) 16 | (def always-passwall False) 17 | (def super-speed False) 18 | 19 | (def autosave True) 20 | 21 | (def inventory-limit 8) 22 | (def max-dungeon-level 19) 23 | 24 | (def message-lines 5) 25 | (def map-border-width 2) 26 | (def text-screen-left-margin 1) 27 | (def text-screen-page-overlap 2) 28 | 29 | (def max-message-log-len 200) 30 | 31 | (def fg-color :black) 32 | (def bg-color :white) 33 | (def pick-bg-color (fn [fg] 34 | (if (in fg [bg-color :yellow]) 35 | :dark-gray 36 | bg-color))) 37 | (def unseen-color :dark-gray) 38 | (def off-map-color :very-dark-gray) 39 | (def announcer-colors { 40 | 'tara :blue 41 | 'bob :red 42 | 'aud :dark-green}) 43 | (def unid-item-color :purple) 44 | (def hallucinated-object-color :purple) 45 | 46 | (def time-bar-width 10) 47 | (setv time-bar-chunk-chars " ▏▎▍▌▋▊▉█") 48 | (def time-warnings [ 49 | ; Each element is a proportion of time remaining and a background color. 50 | ; Lower proportions must come first. 51 | [(/ 1 4) :red] 52 | [(/ 1 2) :orange]]) 53 | 54 | (def new-msg-highlight curses.A-BOLD) 55 | 56 | (def key-escape "\x1b") 57 | 58 | (def score-interval ".8") 59 | 60 | (defs invlets (list "abcdefghijklmnopqrstuvwxyz")) 61 | 62 | (def color-numbers { 63 | :black 16 64 | :white 15 65 | :dark-gray 244 66 | :very-dark-gray 235 67 | :red 196 68 | :dark-red 88 69 | :pale-pink 219 70 | :hot-pink 205 71 | :green 46 72 | :dark-green 22 73 | :blue 21 74 | :dark-blue 18 75 | :pale-azure 117 76 | :purple 90 77 | :yellow 226 78 | :gold 178 79 | :orange 208 80 | :dark-orange 166 81 | :brown 94}) 82 | 83 | (def clock-factor 1000) 84 | (def clock-unit-name "millisecond") 85 | (def clock-unit-abbr "ms") 86 | 87 | (def vision-radius 20) 88 | (def express-elevator-min-depth 2) 89 | (def express-elevator-max-depth 8) 90 | (def repulsed-from-player-range 20) 91 | (def haste-factor 10) 92 | (def confusion-misdirect-prob .25) 93 | (def spook-radius 5) 94 | (def hallu-prevent-gameover-1in 10) 95 | (def hallu-prevent-gameover-extra-seconds 60) 96 | 97 | ;; * Declarations 98 | 99 | (defs save-file-path None) 100 | (defs scores-file-path None) 101 | (defs dates { 102 | "bundle_created" None 103 | "started" None 104 | "saved" None 105 | "loaded" None}) 106 | (defs bundle-os None) 107 | (defs bundle-git None) 108 | (def version-info None) 109 | 110 | (defs seeds None) 111 | 112 | (def look-mode-legend-height 4) 113 | 114 | (def bottom-border (max look-mode-legend-height (+ message-lines 1))) 115 | ; The extra 1 is for the status line. 116 | 117 | (def T None) ; This will be set to a curses screen. 118 | (def screen-width None) 119 | (def screen-height None) 120 | (def color-pairs {}) 121 | (def locale-encoding None) 122 | (defs message-log []) ; List of (count, text) tuples. 123 | (defs last-new-message-number -1) 124 | (defs last-message-count 0) 125 | 126 | (def screen-mode None) 127 | 128 | (defs player None) 129 | 130 | (def endgame False) 131 | (defs dungeon-level None) 132 | ; 0-based, but displayed as 1-based. 133 | 134 | (defs map-width 0) 135 | (defs map-height 0) 136 | 137 | ; Times are in units of second / clock-factor. 138 | (defs current-time 0) 139 | (defs time-limit None) 140 | (defs last-action-duration 0) 141 | (def super-low-time-threshold (* clock-factor 5)) 142 | 143 | (defs hallucinated-tara None) 144 | (defs hallu-prevented-gameover False) 145 | 146 | (def fov-dirty? True) 147 | (defs seen-map []) 148 | 149 | (defs uniques-generated (set)) 150 | 151 | (defs inventory []) 152 | (def itypes {}) 153 | -------------------------------------------------------------------------------- /roguetv/input.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [amap filt afind ecase block]] [roguetv.macros [*]]) 2 | 3 | (import 4 | [random [choice]] 5 | [heidegger.pos [Pos]] 6 | [kodhy.util [T F ret]] 7 | [roguetv.globals :as G] 8 | [roguetv.util [*]]) 9 | 10 | (setv cancel-keys [" " "\n" G.key-escape]) 11 | 12 | (defn user-confirms [] 13 | (msg "(Hit \"!\" to confirm or any other key to cancel.)") 14 | (rtv display.full-redraw) 15 | (update-msg-highlighting) 16 | (= (G.T.getkey) "!")) 17 | 18 | (defn hit-key-to-continue [keys] 19 | (while T 20 | (when (in (G.T.getkey) keys) 21 | (break)))) 22 | 23 | (setv direction-keys { 24 | 25 | "KEY_UP" Pos.NORTH 26 | "8" Pos.NORTH 27 | "k" Pos.NORTH 28 | "KEY_DOWN" Pos.SOUTH 29 | "2" Pos.SOUTH 30 | "j" Pos.SOUTH 31 | "KEY_LEFT" Pos.WEST 32 | "4" Pos.WEST 33 | "h" Pos.WEST 34 | "KEY_RIGHT" Pos.EAST 35 | "6" Pos.EAST 36 | "l" Pos.EAST 37 | 38 | "KEY_HOME" Pos.NW 39 | "7" Pos.NW 40 | "y" Pos.NW 41 | "KEY_PPAGE" Pos.NE 42 | "9" Pos.NE 43 | "u" Pos.NE 44 | "KEY_END" Pos.SW 45 | "1" Pos.SW 46 | "b" Pos.SW 47 | "KEY_NPAGE" Pos.SE 48 | "3" Pos.SE 49 | "n" Pos.SE}) 50 | 51 | (defn get-direction [key &optional [pure F]] 52 | (setv d (get direction-keys key)) 53 | (if (and (not pure) (.get-effect G.player (rtv-get creature.Confusion)) 54 | (chance G.confusion-misdirect-prob)) 55 | (choice (filt (!= it d) Pos.DIR8)) 56 | d)) 57 | 58 | (defn input-direction [] (block 59 | (msg "In what direction?") 60 | (rtv display.full-redraw) 61 | (update-msg-highlighting) 62 | (while T 63 | (setv key (G.T.getkey)) 64 | (when (in key direction-keys) 65 | (ret (get-direction key))) 66 | (when (in key cancel-keys) 67 | (ret None))))) 68 | 69 | (setv normal-command-keys [ 70 | ["?" :help "Show this help screen"] 71 | ["S" :save-and-quit "Save your game and quit the program"] 72 | ["Q" :resign-game "Resign the game"] 73 | ["m" :message-log "See old messages"] 74 | [";" :look-mode "Enter look mode"] 75 | [":" :examine-ground "Name what's beneath you"] 76 | ["t" :use-tile "Use terrain (e.g., an elevator)"] 77 | ["i" :inventory "Show inventory and examine items"] 78 | ["," :pick-up "Pick up an item at your feet"] 79 | ["d" :drop "Drop an item"] 80 | ["a" :apply-item "Apply (use) an item"] 81 | ["W" :make-wall :debug] 82 | ["R" :reset-level :debug]]) 83 | 84 | (defn get-normal-command [] (block 85 | (while T 86 | (setv key (G.T.getkey)) 87 | (setv inp (cond 88 | [(in key direction-keys) 89 | [:move (get-direction key)]] 90 | [(in key ["." "5" "KEY_B2"]) 91 | :wait] 92 | [(in key ["<" ">"]) 93 | ; Muscle memory for using stairs. 94 | :use-tile] 95 | [(in key (map first normal-command-keys)) 96 | (second (afind (= (first it) key) normal-command-keys))])) 97 | (when inp 98 | (ret inp))))) 99 | 100 | (defn text-screen [text] 101 | 102 | (for [page (rtv display.render-text-screen text)] 103 | (rtv display.draw-text-screen-page page) 104 | (while T 105 | (when (in (G.T.getkey) cancel-keys) 106 | (break))))) 107 | 108 | (defn message-log-screen [] 109 | 110 | (rtv display.draw-message-log T) 111 | (G.T.refresh) 112 | 113 | (while T 114 | (when (in (G.T.getkey) cancel-keys) 115 | (break)))) 116 | 117 | (defn inventory-loop [prompt &optional [select T]] 118 | 119 | (rtv display.draw-inventory prompt) 120 | (G.T.refresh) 121 | 122 | (setv il (amap it.invlet G.inventory)) 123 | 124 | (while T 125 | (setv key (G.T.getkey)) 126 | (setv inp (cond 127 | 128 | [(and select (in key G.invlets)) 129 | (if (in key il) 130 | (.index il key) 131 | (do 132 | (msg "You don't have such an item.") 133 | :quit))] 134 | 135 | [(in key cancel-keys) 136 | :quit])) 137 | 138 | (when (not (none? inp)) 139 | (break))) 140 | 141 | (when (and (numeric? inp) (< inp (len G.inventory))) 142 | inp)) 143 | 144 | (def look-at-keys { 145 | :creature "c" 146 | :item "i" 147 | :tile "t"}) 148 | 149 | (defn look-mode [initial-pos] 150 | (setv prev-screen-mode G.screen-mode) 151 | (setv G.screen-mode :look) 152 | (setv focus G.player.pos) 153 | (while T 154 | (rtv display.full-redraw focus) 155 | (setv key (G.T.getkey)) 156 | (cond 157 | 158 | [(or (in key cancel-keys) 159 | (= key (first (afind (= (second it) :look-mode) normal-command-keys)))) 160 | (break)] 161 | 162 | [(in key direction-keys) (do 163 | (setv new-focus (+ focus (get-direction key :pure T))) 164 | (unless (rtv map.on-map new-focus) 165 | (continue)) 166 | (setv focus new-focus))] 167 | 168 | [(in key (.values look-at-keys)) (do 169 | (setv mapobject-class (ecase key 170 | [(get look-at-keys :creature) 171 | (rtv-get creature.Creature)] 172 | [(get look-at-keys :item) 173 | (when (.visible-item-at G.player focus) 174 | (rtv-get item.Item))] 175 | [(get look-at-keys :tile) 176 | (rtv-get map.Tile)])) 177 | (when (and mapobject-class 178 | (mapobject-class.at focus) 179 | (get G.seen-map focus.x focus.y)) 180 | (text-screen (.information (mapobject-class.at focus)))))])) 181 | 182 | (setv G.screen-mode prev-screen-mode)) 183 | -------------------------------------------------------------------------------- /roguetv/item/__init__.py: -------------------------------------------------------------------------------- 1 | from roguetv.item.generic import * 2 | 3 | # Make sure all the descendant modules are imported, for their 4 | # effects on global variables (like item definitions). 5 | import roguetv.item.misc 6 | import roguetv.item.gadget 7 | import roguetv.item.soda 8 | import roguetv.item.clothing 9 | import roguetv.item.burden 10 | -------------------------------------------------------------------------------- /roguetv/item/burden.hy: -------------------------------------------------------------------------------- 1 | ; This file is for special items that have negative effects and 2 | ; high values. 3 | 4 | (require [kodhy.macros [meth]]) 5 | 6 | (import 7 | random 8 | [kodhy.util [T F]] 9 | [roguetv.english [NounPhrase]] 10 | [roguetv.globals :as G] 11 | [roguetv.util [*]] 12 | [roguetv.map [disc-taxi Tile Floor Ice mset]] 13 | [roguetv.item.generic [Item def-itemtype item-pos]]) 14 | 15 | (defclass Burden [Item] [ 16 | rarity :rare 17 | price-adj :burden]) 18 | 19 | (defclass BigMoney [Burden] [ 20 | char "$" 21 | 22 | info-flavor "Big money! Really heavy money, in fact." 23 | info-carry "Slows your walking speed to {carry-speed-factor} times normal."]) 24 | 25 | (def-itemtype BigMoney "briefcase-cash" :name "briefcase full of cash" 26 | :color-fg :dark-green 27 | :level-lo 4 28 | :carry-speed-factor .9) 29 | 30 | (def-itemtype BigMoney "briefcase-silver" :name "briefcase full of silver ingots" 31 | :color-fg :dark-gray 32 | :level-lo 9 33 | :carry-speed-factor .75) 34 | 35 | (def-itemtype BigMoney "briefcase-gold" :name "briefcase full of gold ingots" 36 | :color-bg :gold 37 | :level-lo 14 38 | :carry-speed-factor .5) 39 | 40 | (def-itemtype BigMoney "gold-boulder" :name "solid gold boulder" 41 | :char "0" 42 | :color-bg :gold 43 | :level-lo 19 44 | 45 | :info-carry "You can't walk. At all." 46 | :superheavy T) 47 | 48 | (defclass CursedGem [Burden] [ 49 | char "*" 50 | unique T]) 51 | 52 | (def-itemtype CursedGem "cursedgem-ice" 53 | :name (NounPhrase "White Ice" :the-proper T) 54 | :color-fg :white 55 | :level-lo 4 56 | 57 | :ice-radius 3 58 | :ice-per-second 3 59 | 60 | :info-flavor "A frost-covered diamond the size of a baseball. You shiver just looking at it." 61 | :info-constant "Produces ice around itself. An ice tile is generated within {ice-radius} squares about {ice-per-second} times per second." 62 | 63 | :__init__ (meth [&kwargs kw] 64 | (CursedGem.__init__ @@ #** kw) 65 | (@schedule) 66 | None) 67 | 68 | :act (meth [] 69 | (setv p (random.choice (disc-taxi (item-pos @@) @ice-radius))) 70 | (when (instance? Floor (Tile.at p)) 71 | (mset p (Ice))) 72 | (@take-time (int (randexp (/ 1 (/ @ice-per-second G.clock-factor))))))) 73 | -------------------------------------------------------------------------------- /roguetv/item/clothing.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [amap filt block meth]] [roguetv.macros [*]]) 2 | 3 | (import 4 | [kodhy.util [T F ret cat]] 5 | [roguetv.strings [gift-box-labels]] 6 | [roguetv.english [NounPhrase]] 7 | [roguetv.globals :as G] 8 | [roguetv.util [*]] 9 | [roguetv.item.generic [Item ItemAppearance def-itemtype]] 10 | [roguetv.creature.monster [Nymph]]) 11 | 12 | (defclass Clothing [Item] [ 13 | char "[" 14 | 15 | open-present-time (seconds 1) 16 | curse-on-unbox F 17 | 18 | info-unidentified "This festively wrapped gift box contains an item of clothing. Your only clue as to what's inside is a cryptic product code. Clothing has a special effect on you so long you carry it, but the effect is suppressed while it's in a box. 'a'pply the box to open it." 19 | 20 | name-suffix (meth [] 21 | (when (and (@identified?) @boxed) 22 | "(boxed)")) 23 | 24 | info-extra (meth [] (cat :sep "\n\n" 25 | (when @boxed 26 | "This item is boxed, suppressing its normal effect when carried. 'a'pply it to open and discard the box.") 27 | (when @curse-on-unbox 28 | "This item becomes cursed when it is unboxed."))) 29 | 30 | __init__ (meth [&kwargs kw] 31 | (Item.__init__ @@ #** kw) 32 | (setv @boxed (.get kw "boxed" T)) 33 | None) 34 | 35 | clone-setup (meth [orig] 36 | (.clone-setup (super Clothing @@) orig) 37 | (setv @boxed orig.boxed)) 38 | 39 | identified? (meth [] 40 | ; Unboxed items count as identified, whether or not you've 41 | ; identified the box type. 42 | (if @boxed 43 | (.identified? (super Clothing @@)) 44 | T)) 45 | 46 | applied (meth [] (block 47 | (unless @boxed 48 | (ret (.applied (super Clothing @@)))) 49 | (.take-time G.player @open-present-time) 50 | (setv was-id? (@identified?)) 51 | (msg "You tear open {}.{}" 52 | (if was-id? 53 | (.format "the box containing {:the}" @@) 54 | (.format "{:the}" @@)) 55 | (if (and was-id? @curse-on-unbox) 56 | (.format " {:He's} cursed." @@) 57 | "")) 58 | (@identify) 59 | (setv @boxed F) 60 | (when @curse-on-unbox 61 | (@mk-curse)) 62 | (unless was-id? 63 | (msg "You found: {}" (self.invstr))))) 64 | 65 | carry-effects-active? (meth [] 66 | (not @boxed))]) 67 | 68 | (defn pair-of [s] 69 | (NounPhrase s :always-plural T :unit "pairs")) 70 | 71 | (def-itemtype Clothing "sneakers" :name (pair-of "expensive sneakers") 72 | :color-fg :white 73 | :level-lo 4 74 | :rarity :uncommon 75 | :info-flavor "Guaranteed to make you run faster and jump higher! Nah, I lied. They only make you run faster. But that's more than can be said for PF Flyers and Cataclysm DDA." 76 | 77 | :carry-speed-factor-smooth-terrain 1.25 78 | :info-carry "You walk at {carry-speed-factor-smooth-terrain} times normal speed on smooth terrain.") 79 | 80 | (def-itemtype Clothing "high-heels" :name (pair-of "fancy high heels") 81 | :color-fg :red 82 | :price-adj :bad-flavor 83 | :level-lo 4 84 | :info-flavor "Unless you're Ginger Rogers, these are going to make you somewhat less graceful." 85 | ; http://www.reelclassics.com/Actresses/Ginger/ginger-article2.htm 86 | 87 | :curse-on-unbox T 88 | :carry-speed-factor .8 89 | :info-carry "You walk at {carry-speed-factor} times normal speed.") 90 | 91 | (def-itemtype Clothing "roller-skates" :name (pair-of "roller skates") 92 | :color-fg :yellow 93 | :level-lo 7 94 | :info-flavor "\"Aurelia, old girl,\" said Archibald Mulliner in a clear, firm voice, \"you are the bee's roller skates.\" And at that she seemed to melt into his embrace. Her lovely face was raised to his. \"Archibald!\" she whispered." 95 | 96 | :carry-speed-factor-smooth-terrain 2 97 | :carry-speed-factor-rough-terrain .25 98 | :info-carry "You walk at {carry-speed-factor-smooth-terrain} times normal speed on smooth terrain, but {carry-speed-factor-rough-terrain} times on rough terrain.") 99 | 100 | (def-itemtype Clothing "cheb-boots" :name (pair-of "Chebyshev boots") 101 | :color-fg :dark-orange 102 | :level-lo 11 103 | :rarity :uncommon 104 | :info-flavor "This vintage Russian footwear makes you feel like a king." 105 | ; Pafnuty Chebyshev was Russian. Kings in chess move according 106 | ; to the Chebyshev metric. 107 | 108 | :carry-cheb-walk T 109 | :info-carry "When you walk, diagonal moves take the same amount of time as orthogonal moves.") 110 | 111 | (setv circ-fmt "You can walk into the {} border of the map to magically wrap around to the farthest available tile on the other side.") 112 | 113 | (def-itemtype Clothing "circ-choker" :name "circular choker" 114 | :color-fg :blue 115 | :level-lo 14 116 | :info-flavor "A close-fitting necklace for the geometrically savvy and the topologically flexible." 117 | 118 | :carry-mapwrap-eastwest T 119 | :info-carry (.format circ-fmt "east or west")) 120 | 121 | (def-itemtype Clothing "circ-ring" :name "circular ring" 122 | :color-fg :blue 123 | :level-lo 16 124 | :info-flavor "Somehow, it looks like a tiny sideways necklace." 125 | 126 | :carry-mapwrap-northsouth T 127 | :info-carry (.format circ-fmt "north or south")) 128 | 129 | (def-itemtype Clothing "distressed-jeans" :name (pair-of "distressed blue jeans") 130 | :color-fg :dark-blue 131 | :price-adj :bad-flavor 132 | :level-lo 2 133 | :info-flavor "These are favored by fashion fanatics, but walking around in pants full of holes and tears may also make you look like a yokel." 134 | 135 | :curse-on-unbox T 136 | :carry-gadget-malfunction-1in 3 137 | :info-carry "When you apply a gadget, there's a 1 in {carry-gadget-malfunction-1in} chance that nothing will happen, wasting a charge.") 138 | 139 | (def-itemtype Clothing "fur-coat" :name "fancy fur coat" 140 | :color-fg :brown 141 | :level-lo 3 142 | :rarity :uncommon 143 | :info-flavor "A thick, luxurious coat made from the pelts of many adorable woodland creatures. When this prize was announced, animal-welfare organizations lambasted Rogue TV, calling for a boycott of the middlingly popular game show. This gave Rogue TV's ratings a much-needed boost." 144 | 145 | :carry-ice-immunity T 146 | :info-carry "You don't slip on ice.") 147 | 148 | (def-itemtype Clothing "ugly-sweater" :name "ugly Christmas sweater" 149 | :color-fg :dark-green 150 | :rarity :uncommon 151 | :info-flavor "You can find this abomination in the dungeon all year round. It's your own ugly little Christmas in July. And, it's a gift that keeps on giving." 152 | 153 | :carry-gen-item Clothing 154 | :info-carry "Each time you enter a new level, an extra present is generated.") 155 | 156 | (def-itemtype Clothing "lab-coat" :name "lab coat" 157 | :color-fg :white 158 | :info-flavor "With this groovy outerwear, you'll be chugging mystery sludge in no time." 159 | 160 | :carry-instant-soda-use T 161 | :info-carry "Removes the basic time cost of drinking sodas.") 162 | 163 | (def-itemtype Clothing "trenchcoat" 164 | :color-fg :brown 165 | :level-lo 1 166 | :info-flavor "It's full of pockets for easy access to all your toys." 167 | 168 | :carry-instant-gadget-use T 169 | :info-carry "Removes the basic time cost of using gadgets.") 170 | 171 | (def-itemtype Clothing "goggles" :name (pair-of "goggles") 172 | :color-fg :dark-red 173 | :price 1 174 | :level-lo 9 175 | :info-flavor "The goggles do nothing!" 176 | ; http://knowyourmeme.com/memes/the-goggles-do-nothing 177 | 178 | :curse-on-unbox T) 179 | 180 | (def-itemtype Clothing "trilby" 181 | :color-fg :black 182 | :level-lo 12 183 | :info-flavor "This refined article of haberdashery may be referred to as a \"fedora\" by uneducated riff-raff. Not the type fit to associate with you, m'lady." 184 | ; http://knowyourmeme.com/memes/fedora-shaming 185 | 186 | :carry-repel-monster Nymph 187 | :info-carry "Repels nymphs.") 188 | 189 | (def-itemtype Clothing "fedora" 190 | :color-fg :orange 191 | :price-adj :bad-flavor 192 | :level-lo 12 193 | :info-flavor "This classy hat will get you allll the ladies, yow! Regardless of your gender and sexual orientation. Sorry, rules are rules." 194 | 195 | :curse-on-unbox T 196 | :carry-gen-monster Nymph 197 | :info-carry "Each time you enter a new level, an extra nymph is generated.") 198 | 199 | (setv (get ItemAppearance.registry Clothing) (amap 200 | (ItemAppearance it (NounPhrase 201 | (+ "present labeled " it) 202 | :plural (+ "presents labeled " it) 203 | :article "a")) 204 | gift-box-labels)) 205 | (assert (>= (len (get ItemAppearance.registry Clothing)) 206 | (len (filt (instance? Clothing it) (.values G.itypes))))) 207 | -------------------------------------------------------------------------------- /roguetv/item/generic.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [lc amap filt afind afind-or whenn ecase block meth]] [roguetv.macros [*]]) 2 | 3 | (import 4 | random 5 | [math [ceil]] 6 | re 7 | [kodhy.util [T F cat keyword->str shift ret]] 8 | roguetv.strings 9 | [roguetv.english [NounPhrase NounPhraseNamed]] 10 | [roguetv.globals :as G] 11 | [roguetv.util [*]] 12 | [roguetv.input [inventory-loop]] 13 | [roguetv.types [MapObject Generated Scheduled Drawable NounPhraseNamed CanBeHallucinated]] 14 | [roguetv.map [Tile room-for?]]) 15 | 16 | (defclass Item [CanBeHallucinated MapObject Drawable NounPhraseNamed Scheduled Generated] [ 17 | escape-xml-in-np-format T 18 | hallu-kind "item" 19 | tid None 20 | ; A string. 21 | appearance None 22 | ; An ItemAppearance. 23 | 24 | info-unidentified "[Missing un-ID text]" 25 | info-flavor "[Missing flavor text]" 26 | info-apply None 27 | info-carry None 28 | info-constant None 29 | 30 | price None 31 | ; The money value of the item, a nonnegative integer. 32 | ; If not set explicitly, def-itemtype will set it. 33 | price-adj None 34 | ; A keyword that can adjust the price set by def-itemtype. 35 | 36 | indestructible F 37 | ; Indestructible items can't be destroyed by, e.g., paper 38 | ; shredders. 39 | carry-speed-factor None 40 | ; A floating-point number multiplying the player's speed 41 | ; when the item is carried. 42 | carry-speed-factor-smooth-terrain None 43 | ; Like .carry-speed-factor, but applies only when exiting 44 | ; smooth terrian. 45 | carry-speed-factor-rough-terrain None 46 | ; Like .carry-speed-factor, but applies only when exiting 47 | ; non-smooth terrian. 48 | superheavy F 49 | ; If T, the player can't walk while carrying this item. 50 | carry-ice-immunity F 51 | ; If T, the player is immune to ice. 52 | carry-cheb-walk F 53 | ; If T, the player walks according to the Chebyshev metric. 54 | carry-mapwrap-eastwest F 55 | ; bleh 56 | carry-mapwrap-northsouth F 57 | ; bleh 58 | carry-gadget-malfunction-1in None 59 | ; A chance of gadgets malfunctioning when they're applied. 60 | carry-instant-gadget-use F 61 | ; Allows the player to apply gadgets without the usual time cost. 62 | carry-instant-soda-use F 63 | ; Allows the player to apply sodas without the usual time cost. 64 | carry-gen-item None 65 | ; If a class, one of that type of item is generated on each 66 | ; new level. 67 | carry-gen-monster None 68 | ; If a type, one of that type of monster is generated on 69 | ; each new level. Unlike carry-gen-item, the type is used 70 | ; directly as the constructor, rather than filtering the 71 | ; types that could be generated for this level. 72 | carry-repel-monster None 73 | ; If a class, monsters of that type will flee from the 74 | ; player. 75 | 76 | __init__ (fn [self &kwargs kw] 77 | (Generated.__init__ self) 78 | (MapObject.__init__ self (.get kw "pos")) 79 | (CanBeHallucinated.__init__ self) 80 | (setv self.invlet None) 81 | (setv self.curse None) 82 | ; Cursed items can't be dropped. 83 | None) 84 | 85 | clone-setup (fn [self orig] 86 | (when orig.curse 87 | (setv self.curse (.clone orig.curse self)))) 88 | 89 | clone (fn [self &optional pos] 90 | (setv new ((type self) :pos pos)) 91 | (.clone-setup new self) 92 | new) 93 | 94 | destroy (fn [self] 95 | ; For cleaning up after an item that no longer exists. For 96 | ; the game effect of destroying an item (which may call this 97 | ; method), see the `delete` method. 98 | (when self.curse 99 | (.destroy self.curse)) 100 | (.destroy (super Item self))) 101 | 102 | get-color-fg (fn [self] 103 | (cond 104 | [(hallu) (CanBeHallucinated.get-color-fg self)] 105 | [(.identified? self) (.get-color-fg (super Item self))] 106 | [True G.unid-item-color])) 107 | 108 | set-appearance (classmethod (fn [self iapp] 109 | (setv self.appearance iapp))) 110 | 111 | identified? (fn [self] 112 | (not (and self.appearance (not self.appearance.known)))) 113 | 114 | identify (fn [self] 115 | (unless (.identified? self) 116 | (setv self.appearance.known T))) 117 | 118 | __format__ (fn [self formatstr] 119 | ; Examples: 120 | ; "{}" hookshot 121 | ; "{:the}" the hookshot 122 | ; "{:the:full}" the hookshot (10) [$5] (see Item.name-suffix) 123 | ; "{:the:most}" the hookshot (10) 124 | ; "{::full}" hookshot (10) [$5] 125 | ; "{:the:true}" the hookshot (even if the player hasn't identified the hookshot yet) 126 | ; "{:the:true,full}" the hookshot (10) [$5] (ditto) 127 | (setv [np-args tags] (.groups (re.match 128 | "( (?: v:)? [^:]* ) (?: : (.+) )?" 129 | formatstr 130 | re.VERBOSE))) 131 | (setv tags (set (if tags (.split tags ",") []))) 132 | (setv name (if (in "true" tags) self.name (.get-name self))) 133 | (.escape self (cat :sep " " 134 | (.__format__ name np-args) 135 | (when (or (in "most" tags) (in "full" tags)) (cat :sep " " 136 | (unless (hallu) (self.name-suffix)) 137 | (when (and (not (hallu)) self.curse) "(cursed)") 138 | (when (in "full" tags) 139 | (.format "[${}]" (self.apparent-price)))))))) 140 | 141 | information (fn [self] 142 | (.format "\n {} {:a:full}\n\n{}" 143 | (.xml-symbol self) 144 | self 145 | (.format 146 | (cond 147 | [(hallu) 148 | (. (.hallucinate self) info)] 149 | [(not (.identified? self)) 150 | self.info-unidentified] 151 | [T (cat :sep "\n\n" 152 | self.info-flavor 153 | (when self.unique "This item is unique.") 154 | (when self.indestructible "This item is indestructible.") 155 | (when self.curse "This item is cursed, preventing you from dropping it. The curse will eventually go away on its own.") 156 | (self.info-extra) 157 | (when self.info-apply (+ "Effect when applied: " self.info-apply)) 158 | (when self.info-carry (+ "Effect when carried: " self.info-carry)) 159 | (when self.info-constant (+ "Constant effect: " self.info-constant)))]) 160 | ; This bit of magic below is to let you use an info 161 | ; string like "Does {foo-bar} and {G.baz-bing}." and 162 | ; these will be replaced with self.foo_bar and 163 | ; G.baz_bing, as you'd expect. 164 | ; 165 | ; An extra feature is that variables whose names end with 166 | ; with "_time" are displayed with `show-duration`, so 167 | ; "Waits for {wait-time}." becomes "Waits for 2 minutes." 168 | ; or whatever. 169 | #** (dict (+ [(, "G" information-G)] (lc [[k v] (.items (. (type self) __dict__))] (, 170 | (.replace k "_" "-") 171 | (if (.endswith k "_time") (show-duration v) v)))))))) 172 | 173 | info-extra (fn [self] 174 | None) 175 | 176 | get-name (fn [self] 177 | (cond 178 | [(hallu) 179 | (CanBeHallucinated.get-name self)] 180 | [(.identified? self) 181 | self.name] 182 | [T 183 | self.appearance.name])) 184 | 185 | apparent-price (fn [self] 186 | (if (and (.identified? self) (not (hallu))) 187 | self.price 188 | "?")) 189 | 190 | invstr (fn [self] 191 | (.format "{} {} {:a:full}" 192 | self.invlet 193 | (.xml-symbol self) 194 | self)) 195 | 196 | delete (fn [self] (block 197 | (when self.indestructible 198 | (ret F)) 199 | (setv where (find-item self)) 200 | (cond 201 | [(instance? Pos where) 202 | (.move self None)] 203 | [(is where G.player) 204 | (.remove G.inventory self)] 205 | [T (do 206 | (assert (hasattr where "item")) 207 | (setv where.item None))]) 208 | (.destroy self) 209 | T)) 210 | 211 | mk-curse (fn [self] 212 | (setv self.curse (Curse self))) 213 | 214 | name-suffix (fn [self] 215 | ; This method can be overridden to provide extra information 216 | ; about an item, like the number of charges. It's only displayed 217 | ; with the "full" or "most" formatting tags. 218 | None) 219 | 220 | applied (fn [self] 221 | ; This is triggered when the player uses the :apply-item command. 222 | (msg "You can't do anything special with {:the}." self)) 223 | 224 | carry-effects-active? (fn [self] 225 | T) 226 | 227 | on-reset-level (fn [self] 228 | ; This is triggered when the level is reset for each item 229 | ; in the player's inventory. 230 | None)]) 231 | 232 | (defn def-itemtype [inherit tid &kwargs attrdict] 233 | 234 | (when (in tid G.itypes) 235 | (raise (ValueError (.format "redeclared item type: {}" tid)))) 236 | 237 | (setv c (type 238 | (str (+ "itype:" tid)) 239 | (if (instance? list inherit) (tuple inherit) (, inherit)) 240 | attrdict)) 241 | (setv (get (globals) c.__name__) c) 242 | ; This ensures that jsonpickle can recreate itypes. 243 | (setv (get G.itypes tid) c) 244 | 245 | (setv c.tid tid) 246 | (when (not-in "name" attrdict) 247 | (setv c.name c.tid)) 248 | (setv c.name (NounPhrase c.name)) 249 | (when (not-in "price" attrdict) 250 | (setv price-grade (.get attrdict "price_grade")) 251 | (unless price-grade (setv price-grade (+ 252 | c.level-lo 253 | (ecase c.price-adj 254 | [None 0] 255 | [:bad-flavor 4] 256 | ; Items that are flavored items (e.g., gadgets) and 257 | ; have generally bad effects are worth more, so they 258 | ; can still be valuable to the player. 259 | [:burden 6]) 260 | ; Items that are high-value but worse than useless. 261 | (ecase c.rarity 262 | [:common 0] 263 | [:uncommon 2] 264 | [:rare 4])))) 265 | (setv c.price (get 266 | [ 267 | 5 6 7 8 10 268 | 12 14 17 20 25 269 | 30 35 40 50 60 270 | 70 80 100 120 140 271 | 170 200 230 275 325 272 | 400 500 600 700 800] 273 | price-grade))) 274 | 275 | c) 276 | 277 | (defclass ItemAppearance [NounPhraseNamed] [ 278 | registry {} 279 | ; A dictionary mapping subclasses of Item to lists of eligible 280 | ; appearances. 281 | 282 | __init__ (fn [self apid name] 283 | ; `apid` is a short string identifying the appearance, whereas 284 | ; `name` is a NounPhrase. 285 | (set-self apid name) 286 | (setv self.known F) 287 | ; .known is true when the player has learned the type of 288 | ; item that goes with this appearance. 289 | None) 290 | 291 | randomize-appearances (classmethod (fn [self] 292 | (setv unused-apps (dict (lc 293 | [[c apps] (.items self.registry)] 294 | (, c (list apps))))) 295 | (for [itype (values-sorted-by-keys G.itypes)] 296 | (whenn (afind-or (issubclass itype it) (.keys unused-apps)) 297 | (.set-appearance itype (randpop (get unused-apps it)))))))]) 298 | 299 | (defclass Curse [Scheduled] [ 300 | curse-fade-time (meth [] 301 | (randexp-dl-div 1)) 302 | 303 | __init__ (meth [host-item] 304 | (set-self host-item) 305 | (@schedule) 306 | (@take-time (@curse-fade-time)) 307 | None) 308 | 309 | clone (meth [new-host-item] 310 | ; Ignore the curse-fade-time of the original. Just make 311 | ; a new curse. 312 | (Curse new-host-item)) 313 | 314 | remove-curse (meth [] 315 | (setv @host-item.curse None) 316 | (when (in @host-item G.inventory) 317 | (msg 'tara "{p:}, the curse on {:your} has faded." @host-item)) 318 | (@deschedule)) 319 | 320 | act (meth [] 321 | (@remove-curse))]) 322 | 323 | (defn add-to-inventory [item] 324 | (.move item None) 325 | (setv il-in-use (amap it.invlet G.inventory)) 326 | (when (or (not item.invlet) (in item.invlet il-in-use)) 327 | ; Assign the oldest invlet not used for an item already in 328 | ; the inventory. 329 | (setv item.invlet (afind-or (not-in it il-in-use) G.invlets)) 330 | ; Move this invlet to the end of 'invlets' (since it's now 331 | ; the most recently used). 332 | (G.invlets.remove item.invlet) 333 | (G.invlets.append item.invlet)) 334 | (.append G.inventory item)) 335 | 336 | (defn drop-pos [p] 337 | ; Try to find a position near 'p' to drop an item. 338 | (afind-or (and (room-for? Item it) (not (. (Tile.at it) container))) (+ 339 | ; Try to drop at 'p'… 340 | [p] 341 | ; …or at a random orthogonal neigbor… 342 | (shuffle (amap (+ p it) Pos.ORTHS)) 343 | ; …or at a random diagonal neighbor. 344 | (shuffle (amap (+ p it) Pos.DIAGS))))) 345 | 346 | (defn find-item [item] 347 | ; Find where an item is, even if it's not on the ground. 348 | (cond 349 | [item.pos 350 | item.pos] 351 | [(in item G.inventory) 352 | G.player] 353 | [T 354 | (afind 355 | (and 356 | (instance? (rtv-get creature.monster.Nymph) it) 357 | (is it.item item)) 358 | (rtv creature.monster.extant-monsters))])) 359 | 360 | (defn item-pos [item] 361 | (setv where (find-item item)) 362 | (if (instance? Pos where) 363 | where 364 | ; Otherwise, 'where' should be a creature. 365 | where.pos)) 366 | 367 | (defn get-other-item [self unid verb] (block 368 | (setv other-items (filt (is-not it self) G.inventory)) 369 | (unless other-items 370 | (if unid 371 | (do 372 | (.use-time-and-charge self) 373 | (msg "Nothing happens.")) 374 | (you-dont-have-anything-to verb)) 375 | (ret)) 376 | (setv item (if unid 377 | (random.choice other-items) 378 | (do 379 | (setv i (inventory-loop (.format "What do you want to {}?" verb))) 380 | (when (none? i) 381 | (ret)) 382 | (get G.inventory i)))) 383 | (when (is item self) 384 | (msg 'bob "What's {p:he} trying? Has {p:he} blown {p:his} wig?") 385 | (ret)) 386 | item)) 387 | -------------------------------------------------------------------------------- /roguetv/item/misc.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [filt whenn block meth]]) 2 | 3 | (import 4 | [kodhy.util [T F ret]] 5 | [roguetv.english [NounPhrase]] 6 | [roguetv.globals :as G] 7 | [roguetv.util [*]] 8 | [roguetv.item.generic [Item def-itemtype get-other-item]] 9 | [roguetv.creature [Haste]] 10 | [roguetv.item.gadget [recharge-gadget]]) 11 | 12 | (def-itemtype Item "aoy" 13 | :name (NounPhrase "Amulet of Yendor" :the-proper T) 14 | :char "☥" 15 | :color-bg :yellow 16 | :info-flavor "Actually, it's only a cheap plastic imitation of the Amulet of Yendor. In other words, it's a prop. The real Amulet has been lost to the ages. But this prop is worth a fabulous cash prize!" 17 | :info-carry "Allows you to take the final down elevator. In fact, the rules of Rogue TV stipulate that you're only granted the Amulet's fabulous cash prize if you take that down elevator. So, try not to run out of time." 18 | :price-grade (+ G.max-dungeon-level 10) 19 | :unique T 20 | :rarity :nongen 21 | :indestructible T) 22 | 23 | (def-itemtype Item "stormbringer" 24 | :name (NounPhrase "Stormbringer" :bare-proper T) 25 | :char ")" 26 | :color-fg :black 27 | :level-lo 14 28 | :unique T 29 | :rarity :rare 30 | :info-flavor "An ancient, malevolent demon in the form of a sword. It's about as powerful and liable to destroy what you love as it sounds." 31 | :apply-time (seconds 1) 32 | :hunger-time (minutes 5) 33 | :price-to-speed-time-ratio 10 34 | 35 | :__init__ (meth [&kwargs kw] 36 | (Item.__init__ @@ #** kw) 37 | (@schedule) 38 | (@take-time (int (randexp @hunger-time))) 39 | None) 40 | 41 | :info-apply "Consumes an item for a temporary speed boost. Cursed items aren't eligible. The speed boost increases your walking speed by a factor of {G.haste-factor} and lasts for {apply-time} per ${price-to-speed-time-ratio} of the item's price, rounded down." 42 | :applied (meth [] 43 | (whenn (get-other-item @@ F "consume") 44 | (.take-time G.player @apply-time) 45 | (@consume-item it))) 46 | 47 | :info-carry "Occasionally activates spontaneously on a random eligible item. On average, this happens once every {hunger-time}." 48 | :act (meth [] 49 | (when (in @@ G.inventory) 50 | (setv l (filt (and (is-not it @@) (not it.curse) (not it.indestructible)) 51 | G.inventory)) 52 | (if l 53 | (do 54 | (setv item (random.choice l)) 55 | (msg "{:Your} {:v:hungers} for {:your}." @@ @@ item) 56 | (@consume-item item)) 57 | (msg "{:Your} {:v:quivers} for a moment." @@ @@))) 58 | (@take-time (int (randexp @hunger-time)))) 59 | 60 | :consume-item (meth [item] (block 61 | (setv price item.price) 62 | (when item.curse 63 | (msg "{:The} {:v:senses} kindred magic in {:the} and {:v:relents}." @@ @@ item @@) 64 | (ret)) 65 | (unless (.delete item) 66 | (msg "{:The} {:v:thirsts} for {:the}, but {:he} {:v:is} unaffected." @@ @@ item item item) 67 | (ret)) 68 | (msg "{:The} {:v:disappears} in a burst of black flame." item item) 69 | (unless (>= price @price-to-speed-time-ratio) 70 | (msg "{:The} {:v:seems} unsatisfied." @@ @@) 71 | (ret)) 72 | (.add-to-player Haste (seconds (inc (// price @price-to-speed-time-ratio))) 73 | ; The effect time is incremented so the player doesn't use it 74 | ; all up just waiting till their next turn. 75 | (fn [] (msg "Dark magic courses through your veins.")) 76 | (fn [] (msg "Dark magic fortifies your speed.")))))) 77 | 78 | (def-itemtype Item "cyec" 79 | :name (NounPhrase "CYEC" :the-proper T) 80 | :char "(" 81 | :level-lo 10 82 | :unique T 83 | :rarity :rare 84 | :info-flavor "This is the celebrated Centurion Yendorian Express Card, the charge card of the rich and famous. \"Hello, this is me, ELOISE, and would you kindly send one roast-beef bone, one raisin, and seven spoons to the top floor and charge it please? Thank you very much.\"" 85 | :apply-time (seconds 1) 86 | :ready-time (minutes 5) 87 | 88 | :__init__ (meth [&kwargs kw] 89 | (Item.__init__ @@ #** kw) 90 | (setv @ready T) 91 | None) 92 | 93 | :name-suffix (meth [] (.format "({})" (if @ready 94 | "ready now" 95 | (+ "ready in " (minsec (max 0 (- @next-turn G.current-time))))))) 96 | 97 | :info-apply "Restores half of a gadget's maximum charges, rounded up. The CYEC can't be applied again for {ready-time}." 98 | :applied (meth [] 99 | (if @ready 100 | (when (recharge-gadget @@ .5 @apply-time 101 | (fn [gadget] (msg "Cha-ching! {:The} {:v:is} charged." gadget gadget))) 102 | (setv @ready F) 103 | (@schedule) 104 | (@take-time @ready-time)) 105 | (msg "You feel that {:the} {:v:is} ignoring you." @@ @@))) 106 | 107 | :act (meth [] 108 | (@deschedule) 109 | (setv @ready T) 110 | (when (in @@ G.inventory) 111 | (msg 'tara "{p}, {:the} is ready for use again." @@)))) 112 | 113 | (def-itemtype Item "test-item" 114 | :name "test item" :name-suffix (fn [self] "(testy)") 115 | :char "&" 116 | :info-flavor "This is a test item. It doesn't do anything." 117 | :price 11 118 | :rarity :nongen) 119 | -------------------------------------------------------------------------------- /roguetv/item/soda.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [amap filt afind-or block meth]] [roguetv.macros [*]]) 2 | 3 | (import 4 | [random [choice]] 5 | [heidegger.pos [Pos]] 6 | [kodhy.util [ret]] 7 | [roguetv.strings [soda-cans]] 8 | [roguetv.english [NounPhrase]] 9 | [roguetv.globals :as G] 10 | [roguetv.util [*]] 11 | [roguetv.map [Tile all-pos upelevator-pos room-for? disc-taxi]] 12 | [roguetv.item.generic [Item ItemAppearance def-itemtype]] 13 | [roguetv.creature [Creature Stink Haste Confusion Strength Passwall Hallucinating]]) 14 | 15 | (defclass Soda [Item] [ 16 | apply-time (seconds 1) 17 | char "!" 18 | 19 | info-unidentified "A Rogue TV-branded insulated miniature aluminum can of some unidentifiable beverage. 'a'pply it to chug it and find out what it is." 20 | 21 | applied (fn [self] (block 22 | (setv was-id? (.identified? self)) 23 | (.identify self) 24 | (unless was-id? 25 | (msg "You had: {}" (self.invstr))) 26 | (unless (afind-or it.carry-instant-soda-use (active-inv)) 27 | (.take-time G.player self.apply-time)) 28 | (.remove G.inventory self) 29 | (.destroy self) 30 | (self.soda-effect)))]) 31 | 32 | (defclass EffectSoda [Soda] [ 33 | effect None 34 | effect-time (seconds 1) 35 | start-msg None 36 | lengthen-msg None 37 | 38 | soda-effect (fn [self] 39 | (.add-to-player self.effect self.effect-time 40 | (fn [] (if (string? self.start-msg) 41 | (msg self.start-msg) 42 | (msg #* self.start-msg))) 43 | (fn [] (if (string? self.lengthen-msg) 44 | (msg self.lengthen-msg) 45 | (msg #* self.lengthen-msg)))))]) 46 | 47 | (defn can-of [s] 48 | (NounPhrase 49 | :stem (+ "can of " s) 50 | :article "a")) 51 | 52 | (def-itemtype Soda "chicken-soup" :name (can-of "chicken soup") 53 | :color-fg :yellow 54 | :level-lo 3 55 | :info-flavor "Tastes like the comforts of home. And it's still piping hot." 56 | :radius-around-upelv 5 57 | 58 | :info-apply "Teleports you back to the up elevator. You'll appear at a random available tile within {radius-around-upelv} squares of the up elevator." 59 | :soda-effect (fn [self] (block 60 | 61 | (for [p (shuffle (disc-taxi (upelevator-pos) self.radius-around-upelv))] 62 | (when (= p G.player.pos) 63 | (msg 'bob "You've always had the power to go back to Kansas.") 64 | ; The Wizard of Oz 65 | (ret)) 66 | (when (room-for? G.player p) 67 | (msg "You teleport near the up elevator." self) 68 | (.move G.player p) 69 | (ret))) 70 | (msg "You feel homesick.")))) 71 | 72 | (def-itemtype Soda "elsewhere-soda" :name (can-of "elsewhere eggnog") 73 | :color-fg :white 74 | :level-lo 8 75 | :info-flavor "It's always Christmas somewhere, right? Isn't that how time zones work?" 76 | :dist-min-quantile 2/3 77 | 78 | :info-apply "Teleports you to a faraway part of the level. Specifically, the distances of all available tiles from you are checked, and you are teleported to a tile with a distance beyond the {dist-min-quantile} quantile." 79 | :soda-effect (meth [] (block 80 | 81 | (setv candidates 82 | (amap (, (dist-taxi G.player.pos it) it) 83 | (filt (room-for? G.player it) 84 | (all-pos)))) 85 | (unless candidates 86 | (msg "You feel cramped.") 87 | (ret)) 88 | (setv candidates (cut (sorted :key first candidates) (min 89 | (dec (len candidates)) 90 | (round (* (len candidates) @dist-min-quantile))))) 91 | (.move G.player (second (choice candidates))) 92 | (msg "You teleport away.")))) 93 | 94 | (def-itemtype Soda "heeling-potion" :name "potion of extra heeling" 95 | ; A pun on Rogue's potion of extra healing. 96 | :color-fg :brown 97 | :price-adj :bad-flavor 98 | :level-lo 3 99 | :level-hi 7 100 | :info-flavor "Drink this magic potion and dogs will come heeling from far and wide." 101 | :dog-summoning-range 3 102 | :dogs-to-summon 5 103 | 104 | :info-apply "Creates {dogs-to-summon} dogs within {dog-summoning-range} squares of you." 105 | :soda-effect (fn [self] 106 | 107 | (setv summoned 0) 108 | (for [p (shuffle (disc-taxi G.player.pos self.dog-summoning-range))] 109 | (when (room-for? Creature p) 110 | (rtv creature.monster.Dog p) 111 | (+= summoned 1) 112 | (when (> summoned self.dogs-to-summon) 113 | (break)))) 114 | (msg (if summoned 115 | (.format "Hey, where'd {} come from?" 116 | (if (= summoned 1) "that dog" "those dogs")) 117 | "You hear plaintive barking.")))) 118 | 119 | (def-itemtype EffectSoda "stink-serum" :name (can-of "stink serum") 120 | ; Inspired by Yipe! III. 121 | :color-fg :dark-green 122 | :level-lo 1 123 | :info-flavor "This refreshing beverage has an odd but tasty flavor with notes of beans, Limburger cheese, durian, and asparagus. The, ah, aftereffects are somewhat less pleasant." 124 | 125 | :info-apply "You'll stink for {effect-time}. While you stink, monsters within {G.repulsed-from-player-range} squares will run away from you." 126 | :effect Stink 127 | :effect-time (seconds 30) 128 | :start-msg ['aud "cries out in disgust at the pungent odor."] 129 | :lengthen-msg ['tara "Smells like {p:the} is going to keep on smelling for a while."]) 130 | 131 | (def-itemtype EffectSoda "speed-soda" :name (can-of "5-second ENERGY™") 132 | ; In reference to the real dietary supplement 5-hour Energy. 133 | :color-fg :red 134 | :level-lo 4 135 | :info-flavor "He's got go power! He's feeling his—aw, phooey, wrong cue card. Anyway, compared to its namesake, which is basically caffeine, this novel beverage is of mysterious origin, and it's got a veritably supernatural kick, for a (very, very) short time." 136 | ; Mid-20th-century Cheerios ads 137 | 138 | :info-apply "Increases your walking speed by a factor of {G.haste-factor} for {effect-time}." 139 | :effect Haste 140 | :effect-time (seconds 5) 141 | :start-msg "You feel extremely jittery." 142 | :lengthen-msg "Your jittering intensifies.") 143 | ; http://knowyourmeme.com/memes/intensifies 144 | 145 | (def-itemtype (get G.itypes "speed-soda") "speed-soda-2" :name (can-of "5-minute ENERGY™") 146 | :level-lo 14 147 | :info-flavor "This extra-strength new-and-improved reformulation of 5-second ENERGY™ is only mildly radioactive." 148 | 149 | :effect-time (minutes 5)) 150 | 151 | (def-itemtype EffectSoda "confusion-soda" :name (can-of "booze") 152 | :color-fg :black 153 | :price-adj :bad-flavor 154 | :level-hi 5 155 | :info-flavor "This is a generous portion of the most popular recreational drug in history, possibly excepting caffeine. Did you know that in 2012, about 3 million deaths (6% of all deaths worldwide) were attributable to alcoholic beverages? Seriously, folks, if you must drink, be very careful about how much you drink and what you do while intoxicated. Anyway, back to your regularly scheduled dumb jokes." 156 | ; World Health Organization. (2014). Global status report on alcohol and health 2014. Retrieved from http://www.who.int/substance_abuse/publications/global_alcohol_report 157 | 158 | :info-apply "Confuses you for {effect-time}. While confused, you have a chance of walking or pointing in the wrong direction." 159 | :effect Confusion 160 | :effect-time (seconds 45) 161 | :start-msg "Wow, that'shh good shhtuff." 162 | :lengthen-msg ['tara "Keep your head in the game, {p}."]) 163 | 164 | (def-itemtype EffectSoda "strength-soda" :name (can-of "Daffy's Elixir") 165 | ; A name for several patent medicines. 166 | :color-fg :dark-blue 167 | :level-hi 6 168 | :info-flavor "This marvelous concoction will give you the strength of a raging bull!" 169 | 170 | :info-apply "Allows you to instantly open doors and chests for {effect-time}." 171 | :effect Strength 172 | :effect-time (minutes 3) 173 | :start-msg "You feel strong." 174 | :lengthen-msg "You feel ready for more gainz.") 175 | ; Bodybuilding slang. 176 | 177 | (def-itemtype EffectSoda "passwall-soda" :name (can-of "pass-through punch") 178 | :color-fg :dark-red 179 | :level-lo 7 180 | :info-flavor "It lets you walk through walls! Too bad it doesn't let you see through walls." 181 | 182 | :info-apply "Allows you to walk through solid obstacles for {effect-time}. If you're inside a wall when the time runs out, you'll be ejected to the nearest free space." 183 | :effect Passwall 184 | :effect-time (seconds 45) 185 | :start-msg "You feel ethereal." 186 | :lengthen-msg "You feel more subtle.") 187 | 188 | (def-itemtype EffectSoda "hallu-soda" :name (can-of "Mountain Dew®") 189 | :color-fg :dark-green 190 | :rarity :uncommon 191 | :price-adj :bad-flavor 192 | :info-flavor "DO THE DEW®" 193 | 194 | :info-apply "Makes you MLG for {effect-time}. What does MLG stand for, anyway?" 195 | :effect Hallucinating 196 | :effect-time (minutes 3) 197 | :start-msg "You feel ready to rek some scrublords." 198 | :lengthen-msg ['bob "Wombo combo!"]) 199 | 200 | (def-itemtype Soda "effect-extend-soda" :name (can-of "effect-extending elixir") 201 | :color-fg :dark-red 202 | :level-lo 11 203 | :info-flavor "Get the extra mile out of your magic potions." 204 | 205 | :info-apply "Doubles the durations of all active status effects." 206 | :soda-effect (meth [] (block 207 | 208 | (unless G.player.effects 209 | (msg 'bob "Oooh, that was a waste.") 210 | (ret)) 211 | 212 | (for [effect G.player.effects] 213 | (.take-time effect (- effect.next-turn G.current-time))) 214 | (msg "You feel more special.")))) 215 | 216 | (def-itemtype Soda "effect-end-soda" :name (can-of "effect-ending elixir") 217 | :color-fg :dark-red 218 | :level-lo 9 219 | :info-flavor "Cures what ails ya, but also what benefits ya, so watch out for that." 220 | 221 | :info-apply "Ends all active status effects." 222 | :soda-effect (meth [] (block 223 | 224 | (unless G.player.effects 225 | (msg "You have a normal feeling for a moment; then it passes.") 226 | (ret)) 227 | 228 | (for [effect G.player.effects] 229 | (.destroy effect))))) 230 | 231 | (def-itemtype Soda "sleep-soda" :name (can-of "Ovaltine®") 232 | :color-fg :dark-orange 233 | :price-adj :bad-flavor 234 | :level-lo 6 235 | :info-flavor (.join "\n\n" ["Here is that drugless way to quiet your ragged nerves so many people are asking about today. Ovaltine marks one of the most important scientific findings of its time." 236 | "(No, seriously, those are exact quotes from Ovaltine ads from the 20s and 30s. So, the questionable claims ads make about dietary supplements these days are not so new. Ovaltine, at least, has cleaned up its act by limiting its claims to the observation that it's micronutrient-foritifed and that these micronutrients are essential for health.)"]) 237 | ; - Collier's, 8 October 1932, p. 29 - http://web.archive.org/http://i.imgur.com/zX4Axys.jpg 238 | ; - Milwaukee Sentinel, 13 Oct 1928, p. 21 - http://web.archive.org/http://i.imgur.com/Q132P5l.png 239 | :sleep-time (seconds 30) 240 | 241 | :info-apply "Makes you fall asleep for {sleep-time}." 242 | :soda-effect (fn [self] 243 | 244 | (.fall-asleep G.player self.sleep-time) 245 | (msg 'tara "Oh no! {p:The} has fallen asleep!"))) 246 | 247 | (setv (get ItemAppearance.registry Soda) (amap 248 | (ItemAppearance it (NounPhrase (+ it " soda can"))) 249 | soda-cans)) 250 | (assert (>= (len (get ItemAppearance.registry Soda)) 251 | (len (filt (instance? Soda it) (.values G.itypes))))) 252 | -------------------------------------------------------------------------------- /roguetv/macros.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [amap]]) 2 | 3 | (import 4 | [hy [HySymbol HyString]]) 5 | 6 | (defmacro set-self [&rest props] 7 | `(do ~@(amap `(setv (. self ~it) ~it) props))) 8 | 9 | (defmacro set-self-nn [&rest props] 10 | `(do ~@(amap `(unless (none? ~it) (setv (. self ~it) ~it)) props))) 11 | 12 | (defmacro rtv-get [x] 13 | (setv i (.rindex x ".")) 14 | (setv xname (HySymbol (cut x (+ 1 i)))) 15 | (setv module (HySymbol (+ "roguetv." (cut x 0 i)))) 16 | (setv g (gensym)) 17 | `(do (import [~module :as ~g]) (. ~g ~xname))) 18 | 19 | (defmacro rtv [f &rest args] 20 | ; (rtv m1.m2.f a b) => 21 | ; (do (import roguetv.m1.m2) (roguetv.m1.m2.f a b)) 22 | ; but using a gensym for the module name. 23 | `((rtv-get ~f) ~@args)) 24 | -------------------------------------------------------------------------------- /roguetv/main.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [amap filt ecase block λ]] [roguetv.macros [*]]) 2 | 3 | (import 4 | os 5 | locale 6 | curses 7 | [itertools [combinations]] 8 | [heidegger.pos [Pos]] 9 | [kodhy.util [T F ret concat]] 10 | [roguetv.strings] 11 | [roguetv.globals :as G] 12 | [roguetv.util [*]] 13 | [roguetv.input [hit-key-to-continue text-screen]] 14 | [roguetv.types [Scheduled]] 15 | [roguetv.map [room-for?]] 16 | [roguetv.item [Item ItemAppearance def-itemtype]] 17 | [roguetv.mapgen [reset-level]] 18 | [roguetv.attrstr [default-color]] 19 | [roguetv.display [full-redraw describe-tile]] 20 | [roguetv.creature.player [Player]] 21 | [roguetv.saves [write-save-file]] 22 | [roguetv.scores [add-current-game-to-scores show-scores]]) 23 | 24 | (defn new-game [parsed-cmdline-args] 25 | (setv p parsed-cmdline-args) 26 | 27 | (setv G.player (Player)) 28 | (setv Player.name p.name) 29 | 30 | (setv G.seeds {"map" p.map-seed "general" p.general-seed}) 31 | (print (.format "Using map seed {}, general seed {}" 32 | (get G.seeds "map") (get G.seeds "general"))) 33 | (random.seed (get G.seeds "map")) 34 | (ItemAppearance.randomize-appearances) 35 | (random.seed (get G.seeds "general")) 36 | 37 | (setv G.hallucinated-tara (random.choice 38 | (sorted (.keys hallucinated-announcer-names)))) 39 | 40 | (setv G.dungeon-level (or p.start-at-dl 0)) 41 | (reset-level) 42 | 43 | (setv (get G.dates "started") (real-timestamp))) 44 | 45 | (defn main-loop [&optional special] 46 | 47 | (unless (in "ESCDELAY" os.environ) 48 | (setv (get os.environ "ESCDELAY") "10")) 49 | ; This ensures curses will respond to the escape key quickly 50 | ; in keypad mode (which is enabled by curses.wrapper). 51 | 52 | (locale.setlocale locale.LC-ALL "") 53 | (setv G.locale-encoding (locale.getpreferredencoding)) 54 | 55 | (setv exit-reason (block :curses-wrapper (curses.wrapper (fn [scr] 56 | 57 | (setv G.T scr) 58 | (setv [G.screen-height G.screen-width] (G.T.getmaxyx)) 59 | (curses.curs-set 0) ; Make the cursor invisible. 60 | (G.T.bkgd (ord " ") (default-color)) ; Set the background color. 61 | 62 | (setv G.screen-mode :normal) 63 | 64 | (when special 65 | (show-scores G.scores-file-path :show-all (ecase special 66 | [:show-scores F] 67 | [:show-all-scores T])) 68 | (ret ':just-showing-scores)) 69 | 70 | (unless (get G.dates "loaded") 71 | (unless G.debug 72 | (text-screen (.format "\nIn the far-distant future of the year 200X, the story of the lone hero who retrieved the mystical Amulet of Yendor from the depths of the Dungeons of Doom has passed into legend. But the legend lives on in Rogue TV, the hit new game show where one brave contestant races against the clock to collect fabulous prizes! Host {} and color commentator {} will be your guides as you navigate the perils of a family-friendly state-of-the-art dungeon (designed anew for every contestant, and constructed to the highest standards of safety) to the cheers of adoring fans. Will you reach dungeon level {}, where the Amulet of Yendor (worth a fabulous ${}) lies? Or will you go home with a booby prize? It's up to you and the roll of the dice!" 73 | (color-xml "Tara Tanner" (get G.announcer-colors 'tara)) 74 | (color-xml "Robert Babaghanoush" (get G.announcer-colors 'bob)) 75 | (inc G.max-dungeon-level) 76 | (. (get G.itypes "aoy") price)))) 77 | (msg 'tara "The game begins on a level with {} by {} squares. Good luck, {p}." 78 | G.map-width G.map-height) 79 | (msg "Type \"?\" (Shift-\"/\") for help.") 80 | (describe-tile G.player.pos)) 81 | 82 | (Scheduled.game-loop) 83 | 84 | (assert G.endgame) 85 | (setv (get G.dates "ended") (real-timestamp)) 86 | (setv winnings (filt 87 | (or (= G.endgame :won) (not (instance? (get G.itypes "aoy") it))) 88 | G.inventory)) 89 | (defn total [l] 90 | (sum (amap it.price l))) 91 | (setv gross (total winnings)) 92 | (when (in G.endgame [:out-of-time :resigned]) 93 | ; Reduce the player's winnings to the combination of 94 | ; items with the highest total value less than or equal to 95 | ; half the original sum of values. 96 | ; 97 | ; Yes, we're brute-forcing the knapsack problem here. 98 | ; This should be fine so long as the inventory is small. 99 | (setv winnings (list 100 | (max :key total 101 | (filt (<= (total it) (/ gross 2)) 102 | (concat 103 | (amap (list (combinations winnings it)) 104 | (range (inc (len winnings))))))))) 105 | (setv gross (total winnings))) 106 | (.sort winnings :key (λ (, (- it.price) it.tid))) 107 | (unless G.debug 108 | (add-current-game-to-scores G.scores-file-path winnings gross)) 109 | (msg "Game over. Your total winnings are ${}. Hit \"!\" to quit." gross) 110 | (full-redraw) 111 | (hit-key-to-continue "!") 112 | (unless G.debug 113 | (show-scores G.scores-file-path)) 114 | :game-over)))) 115 | 116 | (when (= exit-reason :save-and-quit) 117 | (print "Saving...") 118 | (write-save-file G.save-file-path) 119 | (print "Saved game to" G.save-file-path)) 120 | 121 | exit-reason) 122 | -------------------------------------------------------------------------------- /roguetv/mapgen.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [lc amap filt afind-or replicate block retf cmeth]]) 2 | 3 | (import 4 | random 5 | [random [choice randint normalvariate]] 6 | [heidegger.pos [Pos]] 7 | heidegger.digger 8 | [kodhy.util [T F unique pairs concat shift ret weighted-choice merge-dicts]] 9 | [roguetv.globals :as G] 10 | [roguetv.util [*]] 11 | [roguetv.types [Generated Scheduled LevelTimer set-time-limit]] 12 | [roguetv.map [*]] 13 | [roguetv.fov [init-fov-map]] 14 | [roguetv.item [Item Curse]] 15 | [roguetv.creature [Creature Effect]] 16 | [roguetv.creature.monster [Snail Spider Nymph Dog Cat Golem UmberHulk]]) 17 | 18 | (defn reset-level [&optional [new-seed F]] 19 | 20 | (setv dl G.dungeon-level) 21 | 22 | ; Seed the map generator for this level. 23 | (setv general-rng-state (random.getstate)) 24 | (if new-seed 25 | (random.seed) 26 | (random.seed (repr (, (get G.seeds "map") (int dl))))) 27 | ; This method of seeding might not be particularly smart. 28 | ; For now, I'm just covering for Python 3's lack of 29 | ; random.jumpahead. 30 | 31 | (setv G.map-width (+ 50 (* 4 dl))) 32 | (setv G.map-height (+ 20 (* 2 dl))) 33 | (when (and (not-in dl [0 G.max-dungeon-level]) (1-in 10)) 34 | (if (1-in 2) 35 | (do ; Wide level. 36 | (+= G.map-width (// G.map-width 2)) 37 | (setv G.map-height 20)) 38 | (do ; Square level. 39 | (setv d (// (+ G.map-width G.map-height) 2)) 40 | (setv G.map-width d) 41 | (setv G.map-height d)))) 42 | 43 | (set-time-limit (+ G.current-time (dl-time-limit dl))) 44 | 45 | (setv G.seen-map (amap (* [F] G.map-height) (range G.map-width))) 46 | (for [t [Tile Item Creature]] 47 | (.init-omap t G.map-width G.map-height)) 48 | (for [x (list Scheduled.queue)] 49 | ; Destroy objects that we left behind on the previous level. 50 | (setv keep (cond 51 | [(instance? LevelTimer x) 52 | T] 53 | [(player? x) 54 | T] 55 | [(instance? Effect x) 56 | ; Effects only apply to the player, so they're going 57 | ; with the player. 58 | T] 59 | [(instance? Creature x) 60 | F] 61 | [(instance? Tile x) 62 | F] 63 | [(instance? Item x) 64 | (in x G.inventory)] 65 | [(instance? Curse x) 66 | (in x.host-item G.inventory)] 67 | [T 68 | (raise (ValueError (.format "Weird thing in Schedule.queue: {!r}" x)))])) 69 | (unless keep 70 | (.destroy x))) 71 | (init-fov-map Tile.omap) 72 | ; Now that we're on a new level, the positions of old 73 | ; MapObjects are invalid. But that's okay because there's no 74 | ; way to refer to old MapObjects anymore, either (except for 75 | ; ones with pos None, like the items in the player's 76 | ; inventory). 77 | 78 | ; We have heidegger.digger generate a slightly larger map 79 | ; because it always leaves an outermost border of wall square, 80 | ; which in our case would be redundant with the map border. 81 | (setv dugout (heidegger.digger.generate-map 82 | :room-width [2 8] :room-height [2 5] 83 | :corridor-length [3 10] 84 | :dug-fraction (ilogit (normalvariate (logit .2) .25)) 85 | ; Quantile rank .01 .25 .50 .75 .99 86 | ; Quantile .12 .17 .20 .23 .31 87 | :width (+ G.map-width 2) :height (+ G.map-height 2))) 88 | 89 | (setv free-floors []) 90 | (for [x (range G.map-width)] 91 | (for [y (range G.map-height)] 92 | (setv p (Pos x y)) 93 | (setv floor? (not (get dugout "map" (inc x) (inc y)))) 94 | (when floor? 95 | (.append free-floors p)) 96 | (mset p (if floor? (Floor) (Wall)) T))) 97 | (setv free-floors (shuffle free-floors)) 98 | 99 | ; Add elevators. 100 | ; 101 | ; The up elevator, where the player starts, is always put in 102 | ; the center, which heidegger.digger always leaves as floor. 103 | (setv upelv-pos (Pos (/ G.map-width 2) (/ G.map-height 2))) 104 | (assert (instance? Floor (Tile.at upelv-pos))) 105 | (mset upelv-pos (UpElevator)) 106 | (.remove free-floors upelv-pos) 107 | ; The down elevator is placed randomly. 108 | (mset (shift free-floors) (DownElevator)) 109 | ; Possibly also place an express elevator. 110 | (when (and (< dl (dec G.max-dungeon-level)) (1-in 10)) 111 | (mset (shift free-floors) 112 | (if (and (= dl 0) (1-in 10)) 113 | (Hellevator) 114 | (ExpressElevator :depth (randint 115 | G.express-elevator-min-depth 116 | G.express-elevator-max-depth))))) 117 | 118 | ; Generate the Amulet if the player is on the last level. 119 | (when (= dl G.max-dungeon-level) 120 | ((get G.itypes "aoy") :pos (shift free-floors))) 121 | 122 | ; Add obstacles. 123 | (setv Obstacle.dl dl) 124 | (setv Obstacle.free-floors free-floors) 125 | (setv Obstacle.door-pos (shuffle (concat (amap 126 | (amap (- it (Pos 1 1)) it.doors) 127 | (get dugout "rooms"))))) 128 | (setv Obstacle.golem-pos []) 129 | (for [o-type (select-obstacles dl)] 130 | (.f o-type)) 131 | 132 | ; Add benefits. 133 | (setv Benefit.dl dl) 134 | (setv Benefit.free-floors free-floors) 135 | (for [b-type (select-benefits dl)] 136 | (.f b-type)) 137 | 138 | ; Add items. 139 | (for [[in-chest itype1 itype2] (select-items dl)] 140 | (setv p (shift free-floors)) 141 | (setv itype (if (.unique-and-already-generated itype1) itype2 itype1)) 142 | (itype :pos p) 143 | (when in-chest 144 | (mset p (Chest)))) 145 | 146 | ; Perhaps add a cat. 147 | (when (1-in 20) 148 | (Cat :pos (shift free-floors))) 149 | 150 | ; Switch back to the general seed. Now we can add things to the 151 | ; map that depend on game state. 152 | (random.setstate general-rng-state) 153 | ; Re-shuffle free-floors so it can be influenced by the general 154 | ; RNG state. 155 | (setv free-floors (shuffle free-floors)) 156 | 157 | ; Make extra monsters generated by the player's gear. 158 | (for [x (filt it.carry-gen-monster (active-inv))] 159 | (x.carry-gen-monster :pos (shift free-floors))) 160 | 161 | ; Make extra items generated by the player's gear. 162 | (for [x (filt it.carry-gen-item (active-inv))] 163 | (setv itype (weighted-choice (filt 164 | (issubclass (second it) x.carry-gen-item) 165 | (amap 166 | (, (it.generation-weight dl) it) 167 | (values-sorted-by-keys G.itypes))))) 168 | (itype :pos (shift free-floors))) 169 | 170 | ; Finishing touches. 171 | (.move G.player upelv-pos) 172 | (for [item G.inventory] 173 | (.on-reset-level item))) 174 | 175 | (defn gen-count [dl mean-base mean-dl sd-base sd-dl minimum] 176 | (int (round (max minimum (normalvariate 177 | (+ mean-base (* dl mean-dl)) 178 | (+ sd-base (* dl sd-dl))))))) 179 | (setv gen-count-params (dict 180 | :obstacles (dict 181 | :mean_base 8 :mean_dl 2 182 | :sd_base 3 :sd_dl 1 183 | :minimum 1) 184 | :benefits (dict 185 | :mean_base 0 :mean_dl .5 186 | :sd_base 1 :sd_dl .25 187 | :minimum 0) 188 | :items (dict 189 | :mean_base 4 :mean_dl .5 190 | :sd_base 2 :sd_dl .25 191 | :minimum 1))) 192 | (defn gen-count-for [dl thingtype] 193 | (gen-count :dl dl #** (get gen-count-params thingtype))) 194 | 195 | (defn select-obstacles [dl] 196 | (setv weighted-otypes (amap 197 | (, (it.generation-weight dl) it) 198 | Obstacle.types)) 199 | (replicate (gen-count-for dl "obstacles") 200 | (weighted-choice weighted-otypes))) 201 | 202 | (defn select-benefits [dl] 203 | (setv weighted-btypes (amap 204 | (, (it.generation-weight dl) it) 205 | Benefit.types)) 206 | (replicate (gen-count-for dl "benefits") 207 | (weighted-choice weighted-btypes))) 208 | 209 | (defn select-items [dl] 210 | (replicate (gen-count-for dl "items") 211 | (setv in-chest (1-in 8)) 212 | (setv itype1 (weighted-choice (amap 213 | (, (it.generation-weight dl :in-chest in-chest) it) 214 | (values-sorted-by-keys G.itypes)))) 215 | (setv itype2 (when itype1.unique 216 | ; Pick a non-unique substitute in case item1 has already 217 | ; been generated. We always do this weighted-choice, even 218 | ; if itype1 is new, so that which unique items exist doesn't 219 | ; affect the evolution of the map seed. 220 | (weighted-choice (amap 221 | (, (it.generation-weight dl :in-chest in-chest) it) 222 | (filt (not it.unique) (values-sorted-by-keys G.itypes)))))) 223 | (, in-chest itype1 itype2))) 224 | 225 | (defclass Obstacle [Generated] [ 226 | types []]) 227 | 228 | (defmacro defobst [name inherit &rest body] 229 | `(do 230 | (defclass ~name ~inherit ~@body) 231 | ; Add this obstacle type to the list. 232 | (.append Obstacle.types ~name))) 233 | 234 | (defobst O-Doors [Obstacle] [ 235 | f (cmeth [] (block 236 | (setv n-to-place (inc (// @dl 3))) 237 | (for [p @door-pos] 238 | (when (in p (list @free-floors)) 239 | (mset p (ClosedDoor)) 240 | (.remove @free-floors p) 241 | (-= n-to-place 1) 242 | (unless n-to-place 243 | (ret))))))]) 244 | 245 | (defobst O-EmptyChest [Obstacle] [ 246 | level-lo 9 247 | rarity :uncommon 248 | f (cmeth [] 249 | (mset (shift @free-floors) (Chest)))]) 250 | 251 | (defclass MudlikeObstacle [Obstacle] [ 252 | max-cheb-radius None 253 | make-tile None 254 | 255 | make-tiles (cmeth [ps] 256 | (for [p ps] 257 | (mset p (@make-tile)))) 258 | 259 | f (cmeth [] 260 | (setv mcr (@max-cheb-radius)) 261 | (setv n-to-place (randint 262 | (round (* .25 (** (* 2 mcr) 2))) 263 | (round (* .75 (** (* 2 mcr) 2))))) 264 | (setv start (shift @free-floors)) 265 | (setv occupied [start]) 266 | (block :done (while n-to-place (block :again 267 | (for [op occupied] 268 | (for [d (shuffle Pos.ORTHS)] 269 | (setv p (+ op d)) 270 | (when (and 271 | (<= (dist-cheb start p) mcr) 272 | (in p @free-floors) 273 | (not-in p occupied)) 274 | (.insert occupied (randint 0 (len occupied)) p) 275 | (.remove @free-floors p) 276 | (-= n-to-place 1) 277 | (retf (if n-to-place :again :done))))) 278 | ; We couldn't find anywhere to place the remaining tiles. 279 | ; So, just quit the outer loop. 280 | (break)))) 281 | (@make-tiles occupied))]) 282 | 283 | (defobst O-Slime [MudlikeObstacle] [ 284 | max-cheb-radius (cmeth [] 285 | (+ 2 (// @dl 4))) 286 | make-tile (cmeth [] (Slime))]) 287 | 288 | (defobst O-Ice [MudlikeObstacle] [ 289 | level-lo 1 290 | level-hi 6 291 | max-cheb-radius (cmeth [] 292 | (+ 2 (// @dl 4))) 293 | make-tile (cmeth [] (Ice))]) 294 | 295 | (defobst O-Webs [MudlikeObstacle] [ 296 | level-lo 2 297 | max-cheb-radius (cmeth [] 298 | (+ 1 (// @dl 4))) 299 | make-tile (cmeth [] (Web))]) 300 | 301 | (defobst O-PusherTiles [MudlikeObstacle] [ 302 | level-lo 7 303 | max-cheb-radius (cmeth [] 304 | (+ 2 (// @dl 4))) 305 | make-tiles (cmeth [ps] 306 | (setv open []) 307 | (setv closed (list Pos.ORTHS)) 308 | (for [p ps] 309 | (for [d (list closed)] 310 | (when (and (not-in (+ d p) ps) 311 | (not (. (mget (+ d p)) blocks-movement))) 312 | (.append open d) 313 | (.remove closed d)))) 314 | (setv tile-type (get PusherTile.children 315 | (choice (or open Pos.ORTHS)))) 316 | (for [p ps] 317 | (mset p (tile-type))))]) 318 | 319 | (defobst O-StasisTraps [Obstacle] [ 320 | level-lo 4 321 | off-time-table (pairs 322 | 0 (seconds 10) 323 | 1 (seconds 8) 324 | 2 (seconds 5) 325 | 6 (seconds 4) 326 | 8 (seconds 3) 327 | 10 (seconds 2) 328 | 12 (seconds 2) 329 | 15 (seconds 1) 330 | 18 (seconds .5)) 331 | off-time (cmeth [] 332 | (choice (lc [[min-dl span] @off-time-table] 333 | (>= @dl min-dl) 334 | span))) 335 | on-time (cmeth [] 336 | (seconds (randint 2 (+ 2 @dl)))) 337 | f (cmeth [] 338 | (setv start (get @free-floors 0)) 339 | ; Send two orthogonal line segments out from the start until 340 | ; each end hits a position that isn't a free floor. Place 341 | ; stasis traps along the shorter line segment. 342 | (setv spokes (dict 343 | (amap 344 | (, it (do 345 | (setv spoke [start]) 346 | (while (in (+ (get spoke -1) it) @free-floors) 347 | (.append spoke (+ (get spoke -1) it))) 348 | spoke)) 349 | Pos.ORTHS))) 350 | (setv line (min :key len (shuffle [ 351 | (+ (get spokes Pos.WEST) (get spokes Pos.EAST)) 352 | (+ (get spokes Pos.NORTH) (get spokes Pos.SOUTH))]))) 353 | (setv off-time (@off-time)) 354 | (setv on-time (@on-time)) 355 | (for [p (unique line)] 356 | (.remove @free-floors p) 357 | (mset p (StasisTrap off-time on-time))))]) 358 | 359 | (defobst O-SpookyTotems [Obstacle] [ 360 | level-lo 11 361 | f (cmeth [] 362 | (mset (shift @free-floors) (SpookyTotem)))]) 363 | 364 | (defobst O-Dogs [Obstacle] [ 365 | level-lo 2 366 | rarity :uncommon 367 | f (cmeth [] 368 | (setv n-to-place (+ (// @dl 4) (randint 1 3))) 369 | (for [_ (range n-to-place)] 370 | (Dog :pos (shift @free-floors))))]) 371 | 372 | (defclass NormalMonster [Obstacle] [ 373 | cr-cls None 374 | max-to-place 3 375 | 376 | f (cmeth [] 377 | (setv n-to-place (randint 1 @max-to-place)) 378 | (for [_ (range n-to-place)] 379 | (@cr-cls :pos (shift @free-floors))))]) 380 | 381 | (defobst O-Snails [NormalMonster] [ 382 | cr-cls Snail]) 383 | 384 | (defobst O-Golem [Obstacle] [ 385 | level-lo 2 386 | 387 | max-to-place 3 388 | 389 | f (cmeth [] 390 | (setv n-to-place (randint 1 @max-to-place)) 391 | (for [p (list @free-floors)] 392 | (when (afind-or (or (= it.x p.x) (= it.y p.y)) @golem-pos) 393 | ; Never place a golem on a horizontal or vertical line 394 | ; with another golem. That could make it impossible for 395 | ; the player to get through a corridor. 396 | (continue)) 397 | (Golem :pos p) 398 | (.append @golem-pos p) 399 | (.remove @free-floors p) 400 | (-= n-to-place 1) 401 | (unless n-to-place 402 | (break))))]) 403 | 404 | (defobst O-Spiders [NormalMonster] [ 405 | level-lo 4 406 | cr-cls Spider]) 407 | 408 | (defobst O-Nymph [NormalMonster] [ 409 | level-lo 7 410 | cr-cls Nymph 411 | max-to-place 1]) 412 | 413 | (defclass Benefit [Generated] [ 414 | types []]) 415 | 416 | (defmacro defben [name inherit &rest body] 417 | `(do 418 | (defclass ~name ~inherit ~@body) 419 | ; Add this benefit type to the list. 420 | (.append Benefit.types ~name))) 421 | 422 | (defben B-DoublingMachine [Benefit] [ 423 | f (cmeth [] 424 | (mset (shift @free-floors) (DoublingMachine)))]) 425 | 426 | (defben B-UmberHulk [Benefit] [ 427 | level-lo 2 428 | f (cmeth [] 429 | (UmberHulk :pos (shift @free-floors)))]) 430 | -------------------------------------------------------------------------------- /roguetv/saves.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [lc amap filt afind]]) 2 | 3 | (import 4 | random 5 | gzip 6 | jsonpickle 7 | [kodhy.util [T F concat]] 8 | [roguetv.globals :as G] 9 | [roguetv.util [*]] 10 | [roguetv.types [MapObject Scheduled]] 11 | [roguetv.map [Tile mset tile-save-shorthand]] 12 | [roguetv.fov [init-fov-map]] 13 | [roguetv.item [Item ItemAppearance]] 14 | [roguetv.creature [Creature]] 15 | [roguetv.creature.player [Player]]) 16 | 17 | (defn write-save-file [path] 18 | (setv x {}) 19 | 20 | (setv (get x "general_rng_state") (random.getstate)) 21 | 22 | (setv (get G.dates "saved") (real-timestamp)) 23 | (setv (get x "G") (dict (amap 24 | (, it (getattr G it)) 25 | G.globals-to-save))) 26 | 27 | (setv (get x "Player") { 28 | "name" Player.name}) 29 | 30 | (setv (get x "item_appearances") (dict 31 | (amap (do 32 | (setv ap (. (get G.itypes it) appearance)) 33 | (, it [ap.apid ap.known])) 34 | (filt (. (get G.itypes it) appearance) 35 | (.keys G.itypes))))) 36 | 37 | (setv (get x "omaps") (dict (amap 38 | (, it.__name__ 39 | (filt (not (none? it)) (concat it.omap))) 40 | [Item Creature]))) 41 | (setv (get x "map") (list (reversed (amap (list it) (zip #* (amap 42 | (amap (if (and (in (type it) tile-save-shorthand) (= (tuple (.keys it.__dict__)) (, "pos"))) 43 | (get tile-save-shorthand (type it)) 44 | it) it) 45 | Tile.omap)))))) 46 | 47 | (setv (get x "Scheduled.queue") Scheduled.queue) 48 | 49 | (with [o (gzip.open path "wt" :encoding "UTF-8")] 50 | (o.write (jsonpickle.encode x :warn T :keys T)))) 51 | 52 | (defn load-from-save-file [path] 53 | (with [o (gzip.open path "rt" :encoding "UTF-8")] 54 | (setv x (jsonpickle.decode (.read o) :keys T))) 55 | 56 | (for ([k v] (.items (get x "G"))) 57 | (setattr G k v)) 58 | 59 | (for ([k v] (.items (get x "Player"))) 60 | (setattr Player k v)) 61 | 62 | (for ([tid [apid known]] (.items (get x "item_appearances"))) 63 | (setv itype (get G.itypes tid)) 64 | (.set-appearance itype (afind 65 | (= it.apid apid) 66 | (get ItemAppearance.registry (afind (issubclass itype it) (.keys ItemAppearance.registry))))) 67 | (when known 68 | (setv itype.appearance.known T))) 69 | 70 | ; A bit of extra explicit initialization is necessary here 71 | ; because the omaps, FOV map, and G.player are redundant with 72 | ; MapObject fields. 73 | (for [cls [Tile Item Creature]] 74 | (.init-omap cls G.map-width G.map-height)) 75 | (setv inverted-tile-save-shorthand (dict 76 | (lc [[k v] (.items tile-save-shorthand)] (, v k)))) 77 | (for [[yt row] (enumerate (reversed (get x "map")))] 78 | (for [[xt t] (enumerate row)] 79 | (mset (Pos xt yt) 80 | (if (string? t) ((get inverted-tile-save-shorthand t)) t) 81 | T))) 82 | (for [o (+ (get x "omaps" "Item") (get x "omaps" "Creature"))] 83 | (MapObject.__init__ o o.pos)) 84 | (setv Scheduled.queue (get x "Scheduled.queue")) 85 | (init-fov-map Tile.omap) 86 | 87 | (random.setstate (get x "general_rng_state")) 88 | 89 | (setv (get G.dates "loaded") (real-timestamp))) 90 | 91 | (defn transpose [l] 92 | (amap (list it) (zip #* l))) 93 | -------------------------------------------------------------------------------- /roguetv/scores.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [lc amap afind ecase block λ]]) 2 | 3 | (import 4 | [math [floor ceil]] 5 | [itertools [groupby]] 6 | json 7 | errno 8 | [decimal [Decimal]] 9 | [kodhy.util [T F ret ucfirst keyword->str]] 10 | [roguetv.english [english-list]] 11 | [roguetv.globals :as G] 12 | [roguetv.util [*]] 13 | [roguetv.input [text-screen]]) 14 | 15 | (defn get-scores [path] 16 | (try 17 | (with [o (open path "r" :encoding "UTF-8")] 18 | (setv scores (get (json.load o) "scores"))) 19 | (except [e IOError] 20 | (unless (= e.errno errno.ENOENT) 21 | (raise)) 22 | (setv scores []))) 23 | scores) 24 | 25 | (defn add-current-game-to-scores [path prizes gross] 26 | (setv x (dict 27 | :name (.format "{:a}" G.player) 28 | :dates G.dates 29 | :seeds G.seeds 30 | :bundle-os G.bundle-os 31 | :bundle-git G.bundle-git 32 | :dungeon-level G.dungeon-level 33 | :time G.current-time 34 | :endgame (keyword->str G.endgame) 35 | :gross gross 36 | :prizes (lc [g (amap (list (second it)) (groupby prizes (λ (type it))))] 37 | (if (= (len g) 1) 38 | (.format "{:a:true}" (first g)) 39 | (.format "{} {:num:true}" (len g) (first g)))))) 40 | (setv scores (get-scores path)) 41 | (.append scores x) 42 | ; Sort the highest-scoring characters first, breaking ties with 43 | ; newer characters first. 44 | (.sort scores :reverse T :key (λ (, 45 | (get it "gross") 46 | (get it "dates" "ended")))) 47 | (with [o (open path "w" :encoding "UTF-8")] 48 | (json.dump {"scores" scores} o :sort-keys T))) 49 | 50 | (defn show-scores [path &optional [show-all F]] 51 | 52 | (setv accum [""]) 53 | (defn out [&rest args] 54 | (+= (get accum 0) (+ 55 | (if args (.format (first args) #* (rest args)) "") 56 | "\n"))) 57 | (setv scores (get-scores path)) 58 | 59 | (block 60 | (unless (len scores) 61 | (out "There aren't any scores to show.") 62 | (ret)) 63 | 64 | (out "Games: {}" (len scores)) 65 | (out "Mean score: ${}" 66 | (show-round :ndigits 2 (/ 67 | (sum (amap (get it "gross") scores)) 68 | (len scores)))) 69 | (out) 70 | 71 | (setv latest (max scores :key (λ (get it "dates" "ended")))) 72 | 73 | (when (or (< (len scores) 3) show-all) 74 | (for [character scores] 75 | (out (show-character character latest))) 76 | (ret)) 77 | 78 | (defn print-latest [] 79 | (out "• Last score ({} quantile)" (no-leading-0 80 | (round :ndigits 3 (- 1 (/ (inc (.index scores latest)) (len scores)))))) 81 | (out (show-character latest latest))) 82 | (setv printed-latest F) 83 | 84 | (setv low-quantile (/ (- 1 (Decimal G.score-interval)) 2)) 85 | (setv high-quantile (- 1 low-quantile)) 86 | (for [[text q f] [ 87 | ["High score" high-quantile floor] 88 | ["Median score" .5 round] 89 | ["Low score" low-quantile ceil]]] 90 | (setv target-gross (get scores 91 | (min (dec (len scores)) (int (f (* (len scores) (- 1 q))))) 92 | "gross")) 93 | (setv character (afind (= (get it "gross") target-gross) scores)) 94 | (when (and (not printed-latest) (> (get latest "gross") (get character "gross"))) 95 | (print-latest) 96 | (setv printed-latest T)) 97 | (out (.format "• {} ({} quantile)" text (no-leading-0 q))) 98 | (when (= character latest) 99 | (out "is also the last score") 100 | (setv printed-latest T)) 101 | (out (show-character character latest))) 102 | 103 | (unless printed-latest 104 | (print-latest))) 105 | 106 | (text-screen (first accum))) 107 | 108 | (defn show-character [x &optional latest] 109 | (setv [d1 d2] (amap 110 | (.lstrip (.strftime 111 | (datetime.datetime.strptime 112 | (cut (get x "dates" it) 0 (len "2004-12-31")) 113 | "%Y-%m-%d") 114 | "%d %b %Y") 115 | "0") 116 | ["started" "ended"])) 117 | (.join "\n" [ 118 | (.format "{} ({})" 119 | (color-xml (ucfirst (get x "name")) 120 | :bg (when (and latest (= x latest)) :yellow)) 121 | (if (= d1 d2) 122 | d1 123 | (+ d1 " – " d2))) 124 | (.format "{} level {} {}" 125 | (ecase (get x "endgame") 126 | ["won" "won the game on"] 127 | ["out-of-time" "ran out of time on"] 128 | ["resigned" "resigned on"] 129 | ["used-up-elevator" "took the elevator up from"]) 130 | (inc (get x "dungeon_level")) 131 | (if (< (get x "time") G.clock-factor) 132 | "in less than a second" 133 | (+ "after " (show-duration (get x "time") 134 | :trunc-to-sec T :abbreviate T)))) 135 | (if (get x "prizes") 136 | (.format "with {} worth ${}: {}." 137 | (if (= (len (get x "prizes")) 1) "a prize" "prizes") 138 | (get x "gross") 139 | (english-list (get x "prizes"))) 140 | "empty-handed.") 141 | ""])) 142 | 143 | (defn no-leading-0 [x] 144 | (if (< 0 x 1) 145 | (cut (string x) 1) 146 | (string x))) 147 | -------------------------------------------------------------------------------- /roguetv/strings.hy: -------------------------------------------------------------------------------- 1 | (def bob-too-bad [ 2 | "Sadder than a map!" 3 | "A blamed pity." 4 | "Oh, {p:he's} in a bad loaf now." 5 | "Well, that's how the cookie crumbles." 6 | "Better {p:him} than me." 7 | "Sic semper contestantus." 8 | "Epic fail!" 9 | "TS." 10 | "Tough darts." 11 | "Ain't that a bite!" 12 | "Miz!" 13 | "Nebekh!" 14 | "Très bummer." 15 | "Sad trombone." 16 | "Oh, I'm sorry!" 17 | "The agony of defeat!" 18 | "Shazbot!" 19 | "Press F to pay respects."]) 20 | 21 | (def gadget-adjectives [ 22 | "crazy" 23 | "cryptic" 24 | "mysterious" 25 | "enigmatic" 26 | "Art Deco" 27 | "clockwork" 28 | "futuristic" 29 | "alien" 30 | "modern" 31 | "shiny" 32 | "rusty" 33 | "antique" 34 | "vintage" 35 | "ivory" 36 | "wooden" 37 | "brass" 38 | "silvery" 39 | "stainless-steel" 40 | "matte" 41 | "flimsy" 42 | "rugged" 43 | "plastic" 44 | "Bakelite" 45 | "nylon" 46 | "PVC" 47 | "tiny" 48 | "heavy" 49 | "boxy" 50 | "sleek" 51 | "bulky" 52 | "crude"]) 53 | 54 | (def soda-cans [ 55 | "blank" 56 | "foreign-language-labeled" 57 | "polka-dot" 58 | "striped" 59 | "garishly colored" 60 | "off-white" 61 | "red-checked" 62 | "houndstooth" 63 | "paisley" 64 | "reddish-greenish" 65 | "tie-dye" 66 | "reflective" 67 | ; The idea for the color words is to use ones that appear in 68 | ; none of Rogue 5.4.4, NetHack, or Angband. (Some may be possible 69 | ; hallucinated colors in NetHack.) Also, the weirder the better. 70 | "cornflower-blue" 71 | "periwinkle" 72 | "verdigris" 73 | "teal" 74 | "lovat" 75 | "luteous" 76 | "maroon" 77 | "rufous" 78 | "scarlet" 79 | "hot-pink" 80 | "mauve" 81 | "gamboge" 82 | "fulvous" 83 | "goldenrod" 84 | "nankeen"]) 85 | 86 | (def gift-box-labels [ 87 | "1.21GW" ; Back to the Future 88 | "1729" ; The Hardy–Ramanujan number 89 | "18156248" ; PMID of "Sex, aggression, and humour: responses to unicycling" 90 | "2038019" ; 2038-01-19 is the Unix doomsday 91 | "23.36664" ; sqrt(546), from MLP's Failure Song 92 | "25212683" ; PMID of my first published article 93 | "2FA3E1B" ; Initial commit of Rogue TV 94 | "32W353Y" ; 0xDEADBEEF in RFC 4648 Base32 95 | "41421356" ; sqrt(2) 96 | "6ACCDAE13EFF7I3L" ; First half of Newton's anagram 97 | "794.8" ; Dewey Decimal for computer games 98 | "9N4O4QRR4S8T12UX" ; Second half of Newton's anagram 99 | "AA23C2187" ; Princess Leia was in detention block AA-23, cell 2187 100 | "ARGELFRASTER" ; Enchanted Forest Chronicles 101 | "BIDOOF" ; A Pokémon 102 | "BLINKENLICHTEN" ; http://www.catb.org/jargon/html/B/blinkenlights.html 103 | "CHIM" ; http://www.uesp.net/wiki/Lore:CHIM 104 | "COSMICOSMO" ; Cosmic Osmo 105 | "DOOTDOOT" ; http://knowyourmeme.com/memes/skull-trumpet 106 | "E102G" ; E-102 Gamma (Sonic Adventure) 107 | "ETNOMAILGAT" ; Paul Tagliamonte's (creator of Hy) last name backwards 108 | "FRINDLE" ; The book of the same name 109 | "GIPEMOS" ; "Some pig" (Charlotte's Web) backwards 110 | "GOOZACK" ; Wayside School 111 | "IDDQD" ; Doom cheat code 112 | "KBA" ; My initials 113 | "MUGWORMGRIBLICK" ; Wayside School 114 | "OOSMNSPFRSL" ; Abbreviation for The Origin of Species 115 | "OYGEVALT" ; Oy gevalt 116 | "PYSZCZYNSKI" ; Tom Pyszczynski, TMT researcher 117 | "QLZQQLZUUP" ; The Emperor Quylthulg in Angband 118 | "RETSAMTRAFNEGEL" ; "Legen[dary] fartmaster" (Undertale) backwards 119 | "SLITHYTOVES" ; Jabberwocky 120 | "SPAM" 121 | "SPISPOPD" ; http://doom.wikia.com/wiki/SPISPOPD 122 | "THREEPWOOD" ; Guybrush Threepwood, of the Monkey Island series 123 | "TIBYOCSPNLAAD" ; https://www.reddit.com/r/OutOfTheLoop/comments/1w7ojb 124 | "TVERSKY" ; Amos Tversky, JDM researcher 125 | "UWOTM8" ; http://knowyourmeme.com/memes/u-wot-m8 126 | "WOHBANOBONGU" ; http://cho.cyan.com/rawa/wohba.html 127 | "X3J13" ; Common Lisp standardization committee 128 | "YAGRUMBAGARN" ; http://www.uesp.net/wiki/Morrowind:Yagrum_Bagarn 129 | "ZOOMBINI" ; Zoombinis video-game series 130 | "ZXKUQYB"]) ; A spell in Ultima III 131 | 132 | (def hallucinated-object-strs { 133 | "item" { 134 | "a dank meme" 135 | "Not to be confused with a nice meme." 136 | "a forced meme" 137 | "Widely considered the worst kind." 138 | "a nice meme" 139 | "http://niceme.me" 140 | "a nice meme website" 141 | "http://nicememe.website" 142 | "a nice meme website website" 143 | "http://nicememewebsite.website" 144 | "a nice meme website website website" 145 | "http://nicememewebsitewebsite.website" 146 | "a rare Pepe" 147 | "Always a solid investment." 148 | "a bag of Doritos" 149 | "Oooh, they're mystery-sludge flavor." 150 | "some goblin mail" 151 | ; RuneScape 152 | "But what color is it?" 153 | "a plain gold ring" 154 | ; ZAngband's version of the One Ring 155 | "Where's a volcano when you really need one?" 156 | "an airhorn" 157 | "BYOOO BYOOO" 158 | "the Master Sword" 159 | "It shoots laser beams if you're at full health. Say, what is your health, anyway?" 160 | "a Super Mushroom" 161 | "Maybe you've consumed enough possibly hallucinogenic substances for now." 162 | "the Eye of Larn" 163 | ; The roguelike Larn 164 | "Does advanced dianthroritis lead to coreopsis?" 165 | ; The Secret Life of Walter Mitty 166 | "a ring mail" 167 | ; Starting equipment in Rogue 168 | "Why is this envelope in the shape of a donut?" 169 | "the Amulet of Rodney" 170 | "This isn't what you ordered!" 171 | "an abandoned quiche" 172 | ; http://undertale.wikia.com/wiki/Abandoned_Quiche 173 | "A psychologically damaged spinach egg pie." 174 | "an annoying dog" 175 | ; http://undertale.wikia.com/wiki/Annoying_Dog 176 | "It's clutching a red ball." 177 | "a piece of the Silver Monkey" 178 | ; Legends of the Hidden Temple 179 | "https://www.youtube.com/watch?v=WQvzoY9SaQY\n\nhttps://www.youtube.com/watch?v=PcZawwd7ZZM" 180 | "a half of a Pendant of Life" 181 | ; Legends of the Hidden Temple 182 | "Maybe if you find two, you can make an amulet of life saving." 183 | "the magic of friendship" 184 | ; MLP:FIM 185 | "Multiplayer is not yet implemented." 186 | "a zap apple" 187 | ; http://mlp.wikia.com/wiki/Zap_apple 188 | "This unusual fruit is usually eaten processed into a jam." 189 | "a MacGuffin" 190 | "Finally, what you've spent the whole game searching for!" 191 | "a round tuit" 192 | "Now you can finally do that one thing." 193 | "a turboencabulator" 194 | ; https://en.wikipedia.org/wiki/Turboencabulator 195 | "Careful, this one has only five hydrocoptic marzelvanes." 196 | "a bitcoin" 197 | "Magic Internet money." 198 | ; https://www.reddit.com/r/ads/comments/1q1h40/magic_internet_money 199 | "a copy of Leisure Suit Larry 4" 200 | "Who says sequels have to be done sequentially?" 201 | "a copy of The Secret of Monkey Island disk 22" 202 | "It's subtitled \"The Secret of the Stump\"." 203 | "a Larmers™ brand ham medallion" 204 | ; A running joke on Clickhole 205 | "Larmers™ brand ham medallions are the perfect snack for any occasion. That's why they've been \"America's Favorite Taste\" since 1928." 206 | "Heward's handy Hacky Sack®" 207 | ; A parody of the classic D&D item Heward's handy haversack 208 | "A footbag that's always at the top of your pocket." 209 | "a ten-foot pole" 210 | ; A classic D&D item 211 | "Never leave home without it." 212 | "the Head of Vecna" 213 | ; https://1d4chan.org/wiki/Head_of_Vecna 214 | "A simple Detect Magic spell can go a long way." 215 | "the thing that your aunt gave you" 216 | ; http://everything2.com/title/The+thing+your+aunt+gave+you+which+you+don%27t+know+what+it+is 217 | "You still don't know what it is." 218 | "a can of shark-repelling Bat-Spray" 219 | ; The 1966 Batman movie 220 | "Not to be confused with the other three Oceanic Repellent Bat-Sprays." 221 | "a red velvet bag" 222 | ; Pathways Into Darkness 223 | "It's lighter on the inside." 224 | "some jet" 225 | ; http://fallout.wikia.com/wiki/Jet 226 | "Ugh, this stuff smells like cow manure." 227 | "a potion of objet d'étatisation" 228 | ; A parody of NetHack's potion of object detection 229 | "Excuse my French." 230 | "a beetle in a box" 231 | ; From an argument by Ludwig Wittgenstein 232 | "If a philosopher's writing is so obtuse that only he can understand what he's trying to say, does a reference to his writings have any place in the language-game at all?" 233 | "a demijohn full of anteaters" 234 | "http://arfer.net/anteaters" 235 | "kitten" 236 | "You found kitten!" 237 | "a constitutional amendment" 238 | "If you think it's hard to get one of these in the US, wait till you see Canada's unanimity formula." 239 | "the Medicare donut hole" 240 | "It doesn't look very tasty." 241 | "the Q document" 242 | ; https://en.wikipedia.org/wiki/Q_source 243 | "Looks like Matthew's and Luke's edits were definitely for the better. Just removing Jesus's tedious diatribes about how he didn't want to be a carpenter was a huge improvement." 244 | "the seventh degree of concentration" 245 | ; Heartbreak House 246 | "One difficulty in using psychoactive drugs as some kind of inspiration or means of discovery is that they don't just affect what ideas you come up with; they also affect how you evaluate your ideas—possibly for the worse." 247 | "Illusens Staff" 248 | ; http://items.jellyneo.net/item/9399 249 | "Apostrophes? What are those?" 250 | "the Nutshack" 251 | ; http://knowyourmeme.com/memes/the-nutshack-theme 252 | "It's the Nutshack!"} 253 | ; Not currently possible with roguetv.english: 254 | ; "no tea" 255 | ; ; Another weird inventory item from the HhGttG text adventure 256 | ; "You're talking complete nonsense; pull yourself together." 257 | ; "more cowbell" 258 | ; ; https://en.wikipedia.org/wiki/More_cowbell 259 | ; "If you've got a fever…" 260 | "monster" { 261 | "m:a n00b" 262 | "how do i shot web?" 263 | ; http://knowyourmeme.com/memes/how-do-i-shot-web 264 | "m:a lamer" 265 | "I bet he save-scums." 266 | "m:a cheeky scrublord" 267 | "He only got into Smash Bros. when they added Ryu." 268 | "m:a tryhard" 269 | "The coolest guys make it look easy." 270 | "m:a neckbeard" 271 | "I WANT TENDIES! REEEE!" 272 | "m:a hipster" 273 | "He liked roguelikes before they were cool." 274 | "m:a cuck" 275 | "I remember when my high-school English class was reading The Miller's Tale around 2006 and the teacher explained to us what a cuckold was. Little did I suspect that, a decade later, the word \"cuck\" would end up as a central term of art of a new generation of American white nationalists. These are strange times we live in." 276 | "Barney the Dinosaur" 277 | "Watch out for its deadly singing attack." 278 | "m:Cool Cat" 279 | ; http://knowyourmeme.com/memes/subcultures/cool-cat-saves-the-kids 280 | "There he is!" 281 | "a gnome child" 282 | ; http://knowyourmeme.com/memes/dank-memes 283 | "Born too late to explore the earth. Born too soon to explore the galaxy. Born just in time to be a dank meme." 284 | "m:the Wizard of Yendor" 285 | "\"So thou thought thou couldst elude me, fool.\"" 286 | "the Warden of Yendor" 287 | "An immoral presence stalks through the dungeon, implacably hunting a poor sap who's just trying to quit while he's ahead." 288 | "m:Morgoth" 289 | "His figure is like a light crowning mounted with blackness. No, wait…" 290 | "m:Missingno" 291 | "[Missing info text]" 292 | "m:Sanic" 293 | "This poorly drawn creature seems to be looking for his shoes." 294 | "f:Rainbow Dash" 295 | "A small winged horse known for her speed, agility, guts, style, coolness, awesomeness, and radicalness." 296 | "a calzone golem" 297 | ; http://web.archive.org/web/20150714000709/http://www.albinjohnson.com/d&d/resources/downloaded%20adventures/2%20-%20Cooking.pdf 298 | "Now that's what I call dangerously cheesy." 299 | ; A slogan of Cheetos. 300 | "a gazebo" 301 | ; http://www.comedycorner.org/90.html 302 | "It looks fierce." 303 | "a pizza angel" 304 | ; VeggieTales 305 | " Pizza angel, please come to me.\n Tomato sauce and cheese so gooey.\n Pizza angel, I'm on my knees.\n You're my number one pie from Sicily!" 306 | "a sparkledog" 307 | "Do not steal." 308 | "m:Nicolas Cage" 309 | "How could somebody misfile something? What could be easier? It's all alphabetical. You just put it in the right file! According to alphabetical order! You know: A, B, C, D, E, F, G! H, I, J, K, L, M, N, O, P! Q, R, S, T, U, V! W, X, Y, Z! Huh? That's all you have to do!" 310 | ; Vampire's Kiss 311 | "f:Oprah" 312 | "Everybody in the audience is looking under their seats for their own Amulet of Yendor." 313 | "m:John Cena" 314 | "You can, in fact, see him." 315 | "f:Amelia Earhart" 316 | "So there she is." 317 | "f:Lady Cygna" 318 | ; Loom 319 | "Yes, Bobbin, this is your mother." 320 | "m:Chuck Norris" 321 | "Chuck Norris got to the bonus level in Space Station Silicon Valley.\n\nChuck Norris ascended a foodless atheist survivor.\n\nChuck Norris always goes for the down elevator." 322 | "m:Scumbag Steve" 323 | "\"Hey bro, could I borrow the Amulet of Yendor for a sec?\"\n\nDisappears forever." 324 | "m:Steve Ballmer" 325 | "I think he's an expert in child development, or something." 326 | ; http://knowyourmeme.com/memes/steve-ballmer-monkey-dance 327 | "m:Tommy Oliver" 328 | "The mysterious Green Ranger." 329 | "f:Carmen Sandiego" 330 | "You better watch out. She could steal the whole dungeon." 331 | "m:Cookie Monster" 332 | "Imagine how excited and then disappointed he must've been when he saw all the messages born of EU Directive 2009/136/EC." 333 | "m:a temple guard" 334 | ; Legends of the Hidden Temple 335 | "Uh-oh. Do you have any pendants left?" 336 | "Roko's basilisk" 337 | "Please do not feed the memes." 338 | "a Cyberdemon" 339 | "PROTIP: To defeat the Cyberdemon, shoot at… wait a minute. You don't have a gun. Huh. This could be tricky." 340 | "a brahmin" 341 | ; http://fallout.wikia.com/wiki/Brahmin 342 | "It's double the mooing and double the beef tongue!" 343 | "a cliff racer" 344 | ; http://en.uesp.net/wiki/Morrowind:Cliff_Racer 345 | "They really are everywhere." 346 | "m:John Kal Hune" 347 | ; A character from Glenn Seemann's Shadow Keep who is himself 348 | ; a reference to John Calhoun. 349 | "\"Flying paper airplanes canst be quite fun. Thou shouldst try it some time.\"" 350 | "m:Dr. Sloth" 351 | ; Neopets 352 | "His thesis was about something called immersive advertising." 353 | "m:W. D. Gaster" 354 | ; Undertale 355 | "Insert the Navy SEAL copypasta in Wingdings here." 356 | "m:Herobrine" 357 | ; http://knowyourmeme.com/memes/herobrine 358 | "Don't worry, I removed this character from Rogue TV ages ago." 359 | "the Shareware Demon" 360 | ; Exile: Escape from the Pit 361 | "Your free trial of Rogue TV has ended. To continue past the dreaded Quartz Vein of Crippleware, please send a cashier's check or money order for $14.99 to: The Human Fund, 2880 Broadway, New York, NY, 92880." 362 | ; The Human Fund is from Seinfeld. The address is that of the diner whose exterior is used for Monk's Café. 363 | "f:Miss Zarves" 364 | ; Wayside School 365 | "She's usually found on dungeon level 19. But there is no dungeon level 19." 366 | "f:Julie Winters" 367 | ; The Maxx 368 | "She knows that there's no such thing as a freelance social worker, right?" 369 | "the Jersey Devil" 370 | "Better known as Snooki. Ha, ha, ha, am I right, fellas?" 371 | "m:Skeleton Man" 372 | ; The Axis of Awesome 373 | " All made up of bone,\n Shaped like a man.\n Skeleton feet, skeleton hands.\n He has calcium strength at his command.\n Skeleton Man!" 374 | "a minion" 375 | "Every day we stray further from God's light." 376 | ; http://knowyourmeme.com/memes/everyday-we-stray-further-from-god-s-light 377 | "m:a Starchtrooper" 378 | ; Why's Poignant Guide to Ruby 379 | "Remember, synergy means cartoon foxes." 380 | "a p-zombie" 381 | "It takes one to know one." 382 | "a miniature giant space hamster" 383 | "One imagines it would make for particularly tender spaham." 384 | ; http://spelljammer.wikia.com/wiki/Spaham 385 | "an ROUS" 386 | "Rodents of unusual size? I don't think they exist." 387 | "m:mr skeltal" 388 | ; http://knowyourmeme.com/memes/skull-trumpet 389 | "thank" 390 | "a wordbank" 391 | ; http://knowyourmeme.com/memes/wordbank-walrus 392 | "It stores the words in its tusks." 393 | "m:Milhouse" 394 | ; http://knowyourmeme.com/memes/milhouse-is-not-a-meme 395 | "He's a meme, and that's final." 396 | "m:( ͡° ͜ʖ ͡°)" 397 | ; http://knowyourmeme.com/memes/lenny-face 398 | "( ͡° ͜ʖ ͡°)" 399 | "m:Roland Moralheart" 400 | "Hey, did you ever notice that \"Disraeli\" is an anagram of \"I lead, sir\"?" 401 | "m:Kodi" 402 | "Hey, I'm not supposed to be here! I'm a busy man!"}}) 403 | ; Not currently possible with roguetv.english: 404 | ; "f:your mother" 405 | ; "A being of legendary corpulence." 406 | 407 | (def hallucinated-announcer-names { 408 | ; Each key is a possible hallucinated name for Tara. The value is 409 | ; the corresponding name for Bob. 410 | "Abbot" "Costello" 411 | "Akbar" "Jeff" ; Life in Hell 412 | "Bugs" "Daffy" 413 | "Cher" "Sonny" 414 | "George" "Harold" ; Captain Underpants 415 | "Ginger" "Fred" 416 | "Holmes" "Watson" ; Sherlock Holmes 417 | "Kahneman" "Tversky" 418 | "Kathie Lee" "Regis" 419 | "Mitchell" "Webb" 420 | "Tom" "Jerry" 421 | "Vic" "Ken"}) ; MXC 422 | 423 | (def hallucinated-push-past-verbs [ 424 | "rek" 425 | "no-scope" 426 | "quickscope" 427 | "MLG" 428 | "pwn" 429 | "diss" 430 | "clap back at" 431 | "dominate" 432 | "wavedash past" 433 | "blaze" 434 | "friendzone" 435 | "faze" 436 | "meme" 437 | "accidentally" 438 | "You set up {:the} the bomb."]) 439 | 440 | (def hallucinated-item-verbs [ 441 | "bamboozle" 442 | "be when you grow up" 443 | "censor" 444 | "congratulate" 445 | "cough up" 446 | "debug" 447 | "defenestrate" 448 | "disappoint" 449 | "downsize" 450 | "embarrass" 451 | "embezzle" 452 | "endorse" 453 | "enjoy" ; An action in the HhGttG text adventure 454 | "enshrine" 455 | "excommunicate" 456 | "fight" 457 | "finagle" 458 | "fold, spindle, or mutilate" 459 | "fondly regard" ; http://mspaintadventures.wikia.com/wiki/Fondly_regard_creation 460 | "gank" 461 | "gently caress" ; http://www.urbandictionary.com/define.php?term=Gently%20Caress 462 | "inflate" 463 | "lampoon" 464 | "like on Facebook" 465 | "misunderstand" 466 | "patent" 467 | "politicize" 468 | "polymorph into" 469 | "psychoanalyze" 470 | "reassure" 471 | "redecorate" 472 | "reify" 473 | "repost" 474 | "romanticize" 475 | "sacrifice to Moloch" 476 | "shave" 477 | "slander" 478 | "smuggle" 479 | "steal the identity of" 480 | "stick up your nose" 481 | "trisect" 482 | "tweet" 483 | "unravel" 484 | "upcycle" 485 | "vote for"]) 486 | -------------------------------------------------------------------------------- /roguetv/types.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [amap afind-or whenn ecase λ meth cmeth]]) 2 | 3 | (import 4 | [string [ascii-letters]] 5 | hashlib 6 | [random [choice]] 7 | xml.sax.saxutils 8 | [kodhy.util [T F mins merge-dicts]] 9 | [roguetv.strings [bob-too-bad hallucinated-object-strs]] 10 | [roguetv.english [NounPhraseNamed NounPhrase]] 11 | [roguetv.globals :as G] 12 | [roguetv.util [*]]) 13 | 14 | (defclass Drawable [object] [ 15 | char None 16 | color-fg G.fg-color 17 | color-bg None 18 | 19 | ; These getters are trivial in Drawable, but may be overridden 20 | ; in subclasses. 21 | get-char (fn [self] 22 | self.char) 23 | get-color-fg (fn [self] 24 | self.color-fg) 25 | get-color-bg (fn [self] 26 | self.color-bg) 27 | 28 | xml-symbol (fn [self] 29 | (color-xml 30 | (xml.sax.saxutils.escape (.get-char self)) 31 | (.get-color-fg self) 32 | (.get-color-bg self)))]) 33 | 34 | (defclass MapObject [object] [ 35 | 36 | init-omap (classmethod (fn [self width height] 37 | (setv self.omap (amap (* [None] height) (range width))))) 38 | 39 | __init__ (fn [self &optional pos] 40 | ; 'pos' may be None whenever the object isn't currently 41 | ; on the map. 42 | (setv self.pos None) 43 | (.move self pos) 44 | None) 45 | 46 | move (fn [self p-to &optional [clobber F]] 47 | ; Set 'p-to' to None to remove the object from the map. 48 | ; 49 | ; If 'p-to' is not None, 'clobber' is true, and there's 50 | ; something already at 'p-to', remove it. Otherwise, moving 51 | ; onto a Pos where there's already something else is an 52 | ; error. 53 | (when self.pos 54 | (try 55 | (setv (get self.omap self.pos.x self.pos.y) None) 56 | (except [IndexError]))) 57 | ; An IndexError may arise from the assignment if we've 58 | ; done a .move after an old position has become 59 | ; invalid. This is fine. 60 | (when p-to 61 | (whenn (get self.omap p-to.x p-to.y) 62 | (if clobber 63 | (it.move None) 64 | (raise (ValueError (.format 65 | "tried to move {} to {} where there was already {}" 66 | self p-to it))))) 67 | (setv (get self.omap p-to.x p-to.y) self)) 68 | (setv self.pos p-to)) 69 | 70 | at (classmethod (fn [self pos] 71 | (get self.omap pos.x pos.y)))]) 72 | 73 | (defclass Scheduled [object] [ 74 | queue [] 75 | queue-priority 0 76 | ; Should be an integer. Lower means acting sooner. 77 | 78 | schedule (meth [] 79 | ; The object will first be able to act before any time 80 | ; passes, but after any previously existing objects (of the 81 | ; same or lesser .queue-priority) that are currently ready to 82 | ; act have acted. 83 | (setv @next-turn G.current-time) 84 | (.append @queue @@) 85 | (.sort @queue :key (λ it.queue-priority))) 86 | 87 | scheduled? (meth [] 88 | (hasattr @@ "next_turn")) 89 | 90 | deschedule (meth [] 91 | (when (@scheduled?) 92 | (.remove @queue @@) 93 | (del @next-turn))) 94 | 95 | take-time (meth [duration] 96 | (assert (integer? duration)) 97 | (+= @next-turn duration)) 98 | 99 | wait (meth [] 100 | ; Convenience method for waiting 1 second. 101 | (@take-time (seconds 1))) 102 | 103 | act (meth [] 104 | ; It's this object's turn to act. Go wild, calling 105 | ; .take-time as needed. 106 | (raise (ValueError (.format "No .act implemented for {}" (type @@))))) 107 | 108 | destroy (meth [] 109 | (@deschedule)) 110 | 111 | game-loop (classmethod (meth [] 112 | (while T 113 | (setv actor (first (mins @queue (λ it.next-turn)))) 114 | ; We use (first (mins …)) instead of just (min …) because 115 | ; the behavior of Python's `min` is undefined for ties. 116 | (assert (>= actor.next-turn G.current-time)) 117 | (setv G.current-time actor.next-turn) 118 | (.act actor) 119 | (when G.endgame 120 | (break)))))]) 121 | 122 | (defclass LevelTimer [Scheduled] [ 123 | queue-priority -3 124 | 125 | act (meth [] 126 | (setv seconds-left (// (- G.time-limit G.current-time) G.clock-factor)) 127 | (cond 128 | [seconds-left 129 | (msg 'aud "chants \"{}!\"" 130 | (get 131 | (if (hallu) 132 | ["Fortune" "Of" "Wheel" "Pants" "Fish"] 133 | ["One" "Two" "Three" "Four" "Five"]) 134 | (dec seconds-left)))] 135 | [(and 136 | ; Hallucination has a chance of preventing a game-over, by 137 | ; extending the time limit just as it runs out. 138 | ; This works only once per game. 139 | (hallu) 140 | (not G.hallu-prevented-gameover) 141 | (1-in G.hallu-prevent-gameover-1in)) 142 | (msg 'bob "But what if xXx_{p:}_xXx is not kill?") 143 | (set-time-limit (+ G.time-limit (seconds G.hallu-prevent-gameover-extra-seconds))) 144 | (setv G.hallu-prevented-gameover T)] 145 | [T 146 | (msg 'tara "Alas! {p:The} is out of time. {p:He} may keep only half {p:his} winnings.") 147 | (msg 'bob (choice bob-too-bad)) 148 | (setv G.time-limit None) 149 | (setv G.endgame :out-of-time)]) 150 | (@wait))]) 151 | 152 | (defn set-time-limit [x] 153 | (setv G.time-limit x) 154 | (unless (afind-or (instance? LevelTimer it) Scheduled.queue) 155 | (.insert Scheduled.queue 0 (LevelTimer))) 156 | (assert (instance? LevelTimer (first Scheduled.queue))) 157 | (setv (. (first Scheduled.queue) next-turn) 158 | (- G.time-limit G.super-low-time-threshold))) 159 | 160 | (defclass Generated [object] [ 161 | level-lo 0 162 | level-hi None 163 | rarity :common 164 | unique F 165 | 166 | __init__ (meth [] 167 | (when @unique 168 | (setv tname (. (type @@) __name__)) 169 | (when (in tname G.uniques-generated) 170 | (raise (ValueError (+ "Tried to generate a second instance of a unique type: " tname)))) 171 | (.add G.uniques-generated tname)) 172 | None) 173 | 174 | unique-and-already-generated (cmeth [] 175 | (and @unique (in @__name__ G.uniques-generated))) 176 | 177 | generation-weight (cmeth [dl &optional [in-chest F]] 178 | (when in-chest 179 | ; Chests generate deeper items. 180 | (+= dl 3)) 181 | (if (= @rarity :nongen) 182 | 0 183 | (* 184 | (/ 1 (ecase @rarity 185 | ; Chests make uncommon and rare items more common. 186 | [:common 1] 187 | [:uncommon (if in-chest 2 4)] 188 | [:rare (if in-chest 8 16)])) 189 | (/ 1 (cond 190 | [(< dl @level-lo) 191 | (inc (- @level-lo dl))] 192 | [(and (not (none? @level-hi)) (> dl @level-hi)) 193 | (inc (- dl @level-hi))] 194 | [T 1])))))]) 195 | 196 | (defclass Hallucination [NounPhraseNamed Drawable] [ 197 | all {"item" {} "monster" {}} 198 | 199 | __init__ (meth [kind halluid] 200 | (assert (in kind ["item" "monster"])) 201 | 202 | (setv [gender stem] (cond 203 | [(.startswith halluid "m:") [:male (cut halluid (len "m:"))]] 204 | [(.startswith halluid "f:") [:female (cut halluid (len "f:"))]] 205 | [True [:neuter halluid]])) 206 | 207 | (defn match [s &kwargs kwargs] 208 | (when (.startswith stem s) 209 | (NounPhrase (cut stem (len s)) :gender gender #** kwargs))) 210 | (setv @name (or 211 | (when (= stem "the thing that your aunt gave you") 212 | (NounPhrase "thing that your aunt gave you" 213 | :plural "things that your aunt gave you" 214 | :the-proper T)) 215 | (match "a " 216 | :article "a") 217 | (match "an " 218 | :article "an") 219 | (match "some " 220 | :mass T :unit "thingies") 221 | (match "the " 222 | :the-proper T) 223 | (NounPhrase stem :bare-proper T :gender gender))) 224 | 225 | (setv legal-chars (ecase kind 226 | ["item" "/[]()*!$"] 227 | ["monster" ascii-letters])) 228 | (setv @char (get legal-chars (% 229 | ; Randomly choose a character for the hallucinated object, 230 | ; using `halluid` as the seed (so it's consistent between 231 | ; launches of Rogue TV). 232 | (int.from-bytes :byteorder "big" 233 | (.digest (hashlib.md5 (.encode halluid "UTF-8")))) 234 | (len legal-chars)))) 235 | (setv @info (get hallucinated-object-strs kind halluid)) 236 | (assert (not-in halluid (get Hallucination.all kind))) 237 | (setv (get Hallucination.all kind halluid) @@))]) 238 | 239 | (for [[kind d] (.items hallucinated-object-strs) halluid d] 240 | (Hallucination kind halluid)) 241 | 242 | (defclass CanBeHallucinated [] [ 243 | hallu-kind None 244 | 245 | __init__ (meth [] 246 | (setv @halluid None)) 247 | 248 | hallucinate (meth [] 249 | (unless @halluid 250 | (setv @halluid (random.choice 251 | (list (.keys (get Hallucination.all @hallu-kind)))))) 252 | (get Hallucination.all @hallu-kind @halluid)) 253 | 254 | get-name (meth [] 255 | (if (hallu) 256 | (. (@hallucinate) name) 257 | (.get-name (super CanBeHallucinated @@)))) 258 | 259 | get-char (meth [] 260 | (if (hallu) 261 | (. (@hallucinate) char) 262 | (.get-char (super CanBeHallucinated @@)))) 263 | 264 | get-color-fg (meth [] 265 | (if (hallu) 266 | G.hallucinated-object-color 267 | (.get-color-fg (super CanBeHallucinated @@))))]) 268 | -------------------------------------------------------------------------------- /roguetv/util.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [lc filt ecase]] [roguetv.macros [*]]) 2 | 3 | (import 4 | [math [log sqrt exp ceil]] 5 | random 6 | datetime 7 | [heidegger.pos [Pos]] 8 | [kodhy.util [T F signum seq keyword->str cat]] 9 | [roguetv.strings [hallucinated-announcer-names hallucinated-item-verbs]] 10 | [roguetv.globals :as G]) 11 | 12 | (defn real-timestamp [] 13 | ; "Real" in the sense that this uses real time, not the game's 14 | ; simulated time. 15 | (.isoformat (datetime.datetime.utcnow))) 16 | 17 | (defn logit [x] 18 | (log (/ x (- 1 x)))) 19 | 20 | (defn ilogit [x] 21 | (/ 1 (+ 1 (exp (- x))))) 22 | 23 | (defn chance [x] 24 | (<= (random.random) x)) 25 | 26 | (defn randexp [median] 27 | (random.expovariate (/ (log 2) median))) 28 | 29 | (defn randgeom [mean] 30 | (setv p (/ 1 (+ mean 1))) 31 | (int (ceil (- (/ (log (- 1 (random.random))) (log (- 1 p))) 1)))) 32 | 33 | (defn 1-in [n] 34 | (chance (/ 1 n))) 35 | 36 | (defn shuffle [l] 37 | (setv l (list l)) 38 | (random.shuffle l) 39 | l) 40 | 41 | (defn randpop [l] 42 | (l.pop (random.randrange (len l)))) 43 | 44 | (defn values-sorted-by-keys [x] 45 | (list-comp v [[_ v] (sorted (.items x))])) 46 | 47 | (defn seconds [x] 48 | ; Convert seconds to the internal time representation. 49 | (if x (max 1 (round (* G.clock-factor x))) 0)) 50 | ; (max 1 …) ensures that no nonzero durations will be rounded 51 | ; to 0. 52 | (defn minutes [x] 53 | (seconds (* 60 x))) 54 | (defn round-to-second [duration] 55 | ; Rounds a duration (in the internal time representation) 56 | ; to the nearest second. 57 | (* (round (/ duration G.clock-factor))) G.clock-factor) 58 | 59 | (defn minsec [x] 60 | (setv x (ceil (/ x G.clock-factor))) 61 | (.format "{}:{:02}" (// x 60) (% x 60))) 62 | 63 | (defn show-duration [x &optional [trunc-to-sec F] [abbreviate F]] 64 | (setv parts []) 65 | (.append parts ["h" "hour" (// x (* 60 60 G.clock-factor))]) 66 | (%= x (* 60 60 G.clock-factor)) 67 | (.append parts ["min" "minute" (// x (* 60 G.clock-factor))]) 68 | (%= x (* 60 G.clock-factor)) 69 | (.append parts ["s" "second" (// x G.clock-factor)]) 70 | (%= x G.clock-factor) 71 | (when trunc-to-sec 72 | (setv x 0)) 73 | (.append parts [G.clock-unit-abbr G.clock-unit-name x]) 74 | (.join " " (lc [[abbr name n] parts] 75 | n 76 | (.format "{} {}{}" 77 | n 78 | (if abbreviate abbr name) 79 | (if (and (not abbreviate) (!= n 1)) "s" ""))))) 80 | 81 | (defn show-round [number ndigits] 82 | (setv x (round number ndigits)) 83 | (string (if (= x (int x)) (int x) x))) 84 | 85 | (defn len-taxi [p] 86 | ; The length of a vector according to the taxicab norm (1-norm). 87 | ; So Pos.ORTHS have length 1 and Pos.DIAGS have length 2. 88 | ; In Rogue TV, taxicab geometry is the rule. 89 | (+ (abs p.x) (abs p.y))) 90 | (defn dist-taxi [p1 p2] 91 | (len-taxi (- p1 p2))) 92 | 93 | (defn len-euclid [p] 94 | ; The length of a vector according to the Euclidean norm (2-norm). 95 | ; So Pos.ORTHS have length 1 and Pos.DIAGS have length sqrt(2). 96 | (sqrt (+ (** p.x 2) (** p.y 2)))) 97 | (defn dist-euclid [p1 p2] 98 | (len-euclid (- p1 p2))) 99 | 100 | (defn len-cheb [p] 101 | ; The length of a vector according to the Chebyshev norm (∞-norm). 102 | ; So Pos.ORTHS and Pos.DIAGS all have length 1. 103 | (max (abs p.x) (abs p.y))) 104 | (defn dist-cheb [p1 p2] 105 | (len-cheb (- p1 p2))) 106 | 107 | (defn adjacent? [p1 p2] 108 | (= (dist-cheb p1 p2) 1)) 109 | 110 | (defn line-bresen [p1 p2] 111 | ; Bresenham's line algorithm. Returns a list of Pos. 112 | (setv steep? (> (abs (- p2.y p1.y)) (abs (- p2.x p1.x)))) 113 | (when steep? 114 | (setv p1 (Pos p1.y p1.x)) 115 | (setv p2 (Pos p2.y p2.x))) 116 | (setv swapped F) 117 | (when (> p1.x p2.x) 118 | (setv [p1 p2] [p2 p1]) 119 | (setv swapped T)) 120 | (setv dx (- p2.x p1.x)) 121 | (setv dy (- p2.y p1.y)) 122 | (setv error (// dx 2)) 123 | (setv y p1.y) 124 | (setv out []) 125 | (for [x (seq p1.x p2.x)] 126 | (.append out (if steep? (Pos y x) (Pos x y))) 127 | (-= error (abs dy)) 128 | (when (< error 0) 129 | (+= y (signum dy)) 130 | (+= error dx))) 131 | (when swapped 132 | (.reverse out)) 133 | out) 134 | 135 | (defn dl-time-limit [dl] 136 | (minutes (+ 3 (/ dl 2)))) 137 | 138 | (defn randexp-dl-div [divisor] 139 | (int (randexp (/ (dl-time-limit G.dungeon-level) divisor)))) 140 | 141 | (defn player? [cr] 142 | (is cr G.player)) 143 | 144 | (defn seen [pos] 145 | (get G.seen-map pos.x pos.y)) 146 | 147 | (defn msg [&rest args] 148 | (setv args (list args)) 149 | (setv mtype (when (symbol? (first args)) 150 | (.pop args 0))) 151 | (when mtype 152 | (setv announcer (ecase mtype 153 | ['tara 154 | (+ (if (hallu) G.hallucinated-tara "Tara") ":")] 155 | ['bob 156 | (+ (if (hallu) (get hallucinated-announcer-names G.hallucinated-tara) "Bob") ":")] 157 | ['aud 158 | "The audience"])) 159 | (setv (get args 0) (.format "{} {}" 160 | (color-xml announcer (get G.announcer-colors mtype)) 161 | (get args 0)))) 162 | (setv text (.format (first args) #* (rest args) :p G.player)) 163 | (if (and G.message-log (= (get G.message-log -1 1) text)) 164 | (+= (get G.message-log -1 0) 1) 165 | (.append G.message-log [1 text]))) 166 | 167 | (defn msgp [cr &rest args] 168 | (when (player? cr) 169 | (msg #* args))) 170 | 171 | (defn you-dont-have-anything-to [verb] 172 | (msg "You don't have anything to {}." (if (hallu) 173 | (random.choice hallucinated-item-verbs) 174 | verb))) 175 | 176 | (defn update-msg-highlighting [] 177 | ; This saves the number of the last message and its repeat 178 | ; count. When more messages are printed, we'll highlight them 179 | ; if they're new messages or if the last message had its count 180 | ; increased. 181 | (setv G.message-log (cut G.message-log (- G.max-message-log-len))) 182 | (setv G.last-new-message-number (dec (len G.message-log))) 183 | (setv G.last-message-count (get G.message-log -1 0))) 184 | 185 | (defn color-xml [text &optional fg bg] 186 | ; Formats a colored string for AttrStr. (It should already be 187 | ; escaped for XML.) 188 | (if (or fg bg) 189 | (.format "{}" 190 | (if fg (.format " fg='{}'" (keyword->str fg)) "") 191 | (if bg (.format " bg='{}'" (keyword->str bg)) "") 192 | text) 193 | text)) 194 | 195 | (setv information-G ((type "information-G" (, object) { 196 | "__getattr__" (fn [self name] 197 | (getattr G (.replace name "-" "_")))}))) 198 | 199 | (defn soil-fov [] 200 | (setv G.fov-dirty? T)) 201 | 202 | (defn active-inv [] 203 | (filt (.carry-effects-active? it) G.inventory)) 204 | 205 | (defn hallu [] 206 | (.get-effect G.player (rtv-get creature.generic.Hallucinating))) 207 | -------------------------------------------------------------------------------- /roguetv/xterm_colors.hy: -------------------------------------------------------------------------------- 1 | (def table (, 2 | (, 0 0 0) 3 | (, 128 0 0) 4 | (, 0 128 0) 5 | (, 128 128 0) 6 | (, 0 0 128) 7 | (, 128 0 128) 8 | (, 0 128 128) 9 | (, 192 192 192) 10 | (, 128 128 128) 11 | (, 255 0 0) 12 | (, 0 255 0) 13 | (, 255 255 0) 14 | (, 0 0 255) 15 | (, 255 0 255) 16 | (, 0 255 255) 17 | (, 255 255 255) 18 | (, 0 0 0) 19 | (, 0 0 95) 20 | (, 0 0 135) 21 | (, 0 0 175) 22 | (, 0 0 215) 23 | (, 0 0 255) 24 | (, 0 95 0) 25 | (, 0 95 95) 26 | (, 0 95 135) 27 | (, 0 95 175) 28 | (, 0 95 215) 29 | (, 0 95 255) 30 | (, 0 135 0) 31 | (, 0 135 95) 32 | (, 0 135 135) 33 | (, 0 135 175) 34 | (, 0 135 215) 35 | (, 0 135 255) 36 | (, 0 175 0) 37 | (, 0 175 95) 38 | (, 0 175 135) 39 | (, 0 175 175) 40 | (, 0 175 215) 41 | (, 0 175 255) 42 | (, 0 215 0) 43 | (, 0 215 95) 44 | (, 0 215 135) 45 | (, 0 215 175) 46 | (, 0 215 215) 47 | (, 0 215 255) 48 | (, 0 255 0) 49 | (, 0 255 95) 50 | (, 0 255 135) 51 | (, 0 255 175) 52 | (, 0 255 215) 53 | (, 0 255 255) 54 | (, 95 0 0) 55 | (, 95 0 95) 56 | (, 95 0 135) 57 | (, 95 0 175) 58 | (, 95 0 215) 59 | (, 95 0 255) 60 | (, 95 95 0) 61 | (, 95 95 95) 62 | (, 95 95 135) 63 | (, 95 95 175) 64 | (, 95 95 215) 65 | (, 95 95 255) 66 | (, 95 135 0) 67 | (, 95 135 95) 68 | (, 95 135 135) 69 | (, 95 135 175) 70 | (, 95 135 215) 71 | (, 95 135 255) 72 | (, 95 175 0) 73 | (, 95 175 95) 74 | (, 95 175 135) 75 | (, 95 175 175) 76 | (, 95 175 215) 77 | (, 95 175 255) 78 | (, 95 215 0) 79 | (, 95 215 95) 80 | (, 95 215 135) 81 | (, 95 215 175) 82 | (, 95 215 215) 83 | (, 95 215 255) 84 | (, 95 255 0) 85 | (, 95 255 95) 86 | (, 95 255 135) 87 | (, 95 255 175) 88 | (, 95 255 215) 89 | (, 95 255 255) 90 | (, 135 0 0) 91 | (, 135 0 95) 92 | (, 135 0 135) 93 | (, 135 0 175) 94 | (, 135 0 215) 95 | (, 135 0 255) 96 | (, 135 95 0) 97 | (, 135 95 95) 98 | (, 135 95 135) 99 | (, 135 95 175) 100 | (, 135 95 215) 101 | (, 135 95 255) 102 | (, 135 135 0) 103 | (, 135 135 95) 104 | (, 135 135 135) 105 | (, 135 135 175) 106 | (, 135 135 215) 107 | (, 135 135 255) 108 | (, 135 175 0) 109 | (, 135 175 95) 110 | (, 135 175 135) 111 | (, 135 175 175) 112 | (, 135 175 215) 113 | (, 135 175 255) 114 | (, 135 215 0) 115 | (, 135 215 95) 116 | (, 135 215 135) 117 | (, 135 215 175) 118 | (, 135 215 215) 119 | (, 135 215 255) 120 | (, 135 255 0) 121 | (, 135 255 95) 122 | (, 135 255 135) 123 | (, 135 255 175) 124 | (, 135 255 215) 125 | (, 135 255 255) 126 | (, 175 0 0) 127 | (, 175 0 95) 128 | (, 175 0 135) 129 | (, 175 0 175) 130 | (, 175 0 215) 131 | (, 175 0 255) 132 | (, 175 95 0) 133 | (, 175 95 95) 134 | (, 175 95 135) 135 | (, 175 95 175) 136 | (, 175 95 215) 137 | (, 175 95 255) 138 | (, 175 135 0) 139 | (, 175 135 95) 140 | (, 175 135 135) 141 | (, 175 135 175) 142 | (, 175 135 215) 143 | (, 175 135 255) 144 | (, 175 175 0) 145 | (, 175 175 95) 146 | (, 175 175 135) 147 | (, 175 175 175) 148 | (, 175 175 215) 149 | (, 175 175 255) 150 | (, 175 215 0) 151 | (, 175 215 95) 152 | (, 175 215 135) 153 | (, 175 215 175) 154 | (, 175 215 215) 155 | (, 175 215 255) 156 | (, 175 255 0) 157 | (, 175 255 95) 158 | (, 175 255 135) 159 | (, 175 255 175) 160 | (, 175 255 215) 161 | (, 175 255 255) 162 | (, 215 0 0) 163 | (, 215 0 95) 164 | (, 215 0 135) 165 | (, 215 0 175) 166 | (, 215 0 215) 167 | (, 215 0 255) 168 | (, 215 95 0) 169 | (, 215 95 95) 170 | (, 215 95 135) 171 | (, 215 95 175) 172 | (, 215 95 215) 173 | (, 215 95 255) 174 | (, 215 135 0) 175 | (, 215 135 95) 176 | (, 215 135 135) 177 | (, 215 135 175) 178 | (, 215 135 215) 179 | (, 215 135 255) 180 | (, 215 175 0) 181 | (, 215 175 95) 182 | (, 215 175 135) 183 | (, 215 175 175) 184 | (, 215 175 215) 185 | (, 215 175 255) 186 | (, 215 215 0) 187 | (, 215 215 95) 188 | (, 215 215 135) 189 | (, 215 215 175) 190 | (, 215 215 215) 191 | (, 215 215 255) 192 | (, 215 255 0) 193 | (, 215 255 95) 194 | (, 215 255 135) 195 | (, 215 255 175) 196 | (, 215 255 215) 197 | (, 215 255 255) 198 | (, 255 0 0) 199 | (, 255 0 95) 200 | (, 255 0 135) 201 | (, 255 0 175) 202 | (, 255 0 215) 203 | (, 255 0 255) 204 | (, 255 95 0) 205 | (, 255 95 95) 206 | (, 255 95 135) 207 | (, 255 95 175) 208 | (, 255 95 215) 209 | (, 255 95 255) 210 | (, 255 135 0) 211 | (, 255 135 95) 212 | (, 255 135 135) 213 | (, 255 135 175) 214 | (, 255 135 215) 215 | (, 255 135 255) 216 | (, 255 175 0) 217 | (, 255 175 95) 218 | (, 255 175 135) 219 | (, 255 175 175) 220 | (, 255 175 215) 221 | (, 255 175 255) 222 | (, 255 215 0) 223 | (, 255 215 95) 224 | (, 255 215 135) 225 | (, 255 215 175) 226 | (, 255 215 215) 227 | (, 255 215 255) 228 | (, 255 255 0) 229 | (, 255 255 95) 230 | (, 255 255 135) 231 | (, 255 255 175) 232 | (, 255 255 215) 233 | (, 255 255 255) 234 | (, 8 8 8) 235 | (, 18 18 18) 236 | (, 28 28 28) 237 | (, 38 38 38) 238 | (, 48 48 48) 239 | (, 58 58 58) 240 | (, 68 68 68) 241 | (, 78 78 78) 242 | (, 88 88 88) 243 | (, 98 98 98) 244 | (, 108 108 108) 245 | (, 118 118 118) 246 | (, 128 128 128) 247 | (, 138 138 138) 248 | (, 148 148 148) 249 | (, 158 158 158) 250 | (, 168 168 168) 251 | (, 178 178 178) 252 | (, 188 188 188) 253 | (, 198 198 198) 254 | (, 208 208 208) 255 | (, 218 218 218) 256 | (, 228 228 228) 257 | (, 238 238 238) 258 | )) 259 | -------------------------------------------------------------------------------- /run.hy: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env hy 2 | 3 | ;(import sys) (setv sys.path ["." "/usr/lib/python3.5" "/usr/lib/python3.5/lib-dynload"]) 4 | 5 | (require [kodhy.macros [afind-or qw]]) 6 | 7 | (import 8 | os 9 | os.path 10 | [roguetv.globals :as G] 11 | roguetv.cmdline 12 | roguetv.main) 13 | 14 | (roguetv.cmdline.parse-env) 15 | (setv p (roguetv.cmdline.parse-args)) 16 | 17 | (setv G.save-file-path p.save) 18 | (setv G.scores-file-path p.scores) 19 | (setv G.autosave (not p.no-autosave)) 20 | (setv G.debug p.debug) 21 | 22 | (when (or p.show-scores p.show-all-scores) 23 | (roguetv.main.main-loop (if p.show-all-scores :show-all-scores :show-scores)) 24 | (exit)) 25 | 26 | (if (os.path.exists p.save) 27 | (do 28 | (import roguetv.saves) 29 | (roguetv.saves.load-from-save-file G.save-file-path)) 30 | (do 31 | (roguetv.main.new-game p))) 32 | 33 | (when (afind-or (os.path.exists (+ "roguetv_init." it)) (qw hy py pyc)) 34 | (import roguetv-init)) 35 | 36 | (setv exit-reason (roguetv.main.main-loop)) 37 | 38 | (unless (or p.debug (= exit-reason :save-and-quit)) 39 | (try (os.remove p.save) 40 | (except [OSError]))) 41 | -------------------------------------------------------------------------------- /test/test_english.hy: -------------------------------------------------------------------------------- 1 | (import 2 | unittest 3 | [kodhy.util [T F]] 4 | [roguetv.english [pronoun verb NounPhrase]]) 5 | 6 | (defmacro a= [&rest args] 7 | (setv [x v] [(butlast args) (get args -1)]) 8 | `(.assertEqual self (~@x) ~v)) 9 | 10 | (defn npf [np form] (cond 11 | [(= form "ds") 12 | (.format "{:The} {:v:is} destroyed." np np)] 13 | [(= form "dp") 14 | (.format "{:p-The} {:p-v:is} destroyed." np np)] 15 | ; "This", etc., are not currently implemented. 16 | ; [(= form "t1s") 17 | ; (.format "{:This} {:v:is} destroyed." np np)] 18 | ; [(= form "t1p") 19 | ; (.format "{:These} {:p-v:is} destroyed." np np)] 20 | ; [(= form "t2s") 21 | ; (.format "{:That} {:v:is} destroyed." np np)] 22 | ; [(= form "t2p") 23 | ; (.format "{:Those} {:p-v:is} destroyed." np np)] 24 | [(= form "is") 25 | (.format "{:A} {:v:is} here." np np)] 26 | [(= form "ip") 27 | (.format "{:Some} {:p-v:is} here." np np)] 28 | [(= form "p") 29 | (.format "{:Your} {:v:is} destroyed." np np)] 30 | [(= form "n") 31 | (.format "You won 2 {:num}." np)])) 32 | 33 | (defmacro npf= [np form answer] 34 | `(.assertEqual self (npf ~np ~(name form)) ~answer)) 35 | 36 | (defclass C [unittest.TestCase] [ 37 | 38 | test-pronoun-they (fn [self] 39 | (a= pronoun "they" :gender :male "he") 40 | (a= pronoun "their" :gender :female "her") 41 | (a= pronoun "their" :person 1 "my") 42 | (a= pronoun "their" :person 1 :plural T "our") 43 | (a= pronoun "theirs" :person 1 :plural T "ours") 44 | (a= pronoun "themself" :gender :singular-they "themself") 45 | (a= pronoun "themself" :gender :female "herself") 46 | (a= pronoun "themself" :gender :female :plural T "themselves") 47 | (a= pronoun "they're" :person 2 "you're") 48 | (a= pronoun "they've" :person 2 "you've") 49 | (a= pronoun "they'll" :gender :female "she'll") 50 | (a= pronoun "they'd" :gender :female "she'd")) 51 | 52 | test-pronoun-he-hers (fn [self] 53 | (a= pronoun "he" :gender :male "he") 54 | (a= pronoun "his" :gender :female "her") 55 | (a= pronoun "his" :person 1 "my") 56 | (a= pronoun "his" :person 1 :plural T "our") 57 | (a= pronoun "hers" :person 1 :plural T "ours") 58 | (a= pronoun "himself" :gender :singular-they "themself") 59 | (a= pronoun "himself" :gender :female "herself") 60 | (a= pronoun "himself" :gender :female :plural T "themselves") 61 | (a= pronoun "he's" :person 2 "you're") 62 | (a= pronoun "he'll" :gender :female "she'll") 63 | (a= pronoun "he'd" :gender :female "she'd")) 64 | 65 | test-pronoun-cap (fn [self] 66 | (a= pronoun "They" :gender :female "She") 67 | (a= pronoun "Themself" :person 1 :plural T "Ourselves") 68 | (a= pronoun "His" :gender :singular-they "Their") 69 | (a= pronoun "Hers" :gender :singular-they "Theirs")) 70 | 71 | test-verb-be-present (fn [self] 72 | (a= verb "is" :gender :male "is") 73 | (a= verb "is" :gender :male :plural T "are") 74 | (a= verb "is" :person 1 "am")) 75 | 76 | test-verb-be-past (fn [self] 77 | (a= verb "was" :gender :male "was") 78 | (a= verb "was" :gender :male :plural T "were") 79 | (a= verb "was" :person 1 "was")) 80 | 81 | test-verb-present-have (fn [self] 82 | (a= verb "has" :gender :male "has") 83 | (a= verb "has" :gender :male :plural T "have") 84 | (a= verb "has" :person 1 "have")) 85 | 86 | test-verb-present-swim (fn [self] 87 | (a= verb "swims" :gender :male "swims") 88 | (a= verb "swims" :gender :male :plural T "swim") 89 | (a= verb "swims" :person 1 "swim")) 90 | 91 | test-verb-other (fn [self] 92 | (a= verb "buzzes" :plural T "buzz") 93 | (a= verb "catches" :plural T "catch") 94 | (a= verb "lurches" :plural T "lurch") 95 | (a= verb "embargoes" :plural T "embargo") 96 | (a= verb "does" :plural T "do") 97 | (a= verb "cries" :plural T "cry")) 98 | 99 | test-npformat-count (fn [self] 100 | (setv np (NounPhrase "stapler")) 101 | (npf= np :ds "The stapler is destroyed.") 102 | (npf= np :dp "The staplers are destroyed.") 103 | (npf= np :is "A stapler is here.") 104 | (npf= np :ip "Some staplers are here.") 105 | (npf= np :p "Your stapler is destroyed.") 106 | (npf= np :n "You won 2 staplers.") 107 | 108 | ; Manually setting the article. 109 | (setv np (NounPhrase "stapler" :article "an")) 110 | (npf= np :is "An stapler is here.")) 111 | 112 | test-npformat-count-irregplural (fn [self] 113 | ; Automatically detectable by `inflect`. 114 | (setv np (NounPhrase "mouse")) 115 | (npf= np :ds "The mouse is destroyed.") 116 | (npf= np :dp "The mice are destroyed.") 117 | ; (npf= np :t1s "This mouse is destroyed.") 118 | ; (npf= np :t1p "These mice are destroyed.") 119 | ; (npf= np :t2s "That mouse is destroyed.") 120 | ; (npf= np :t2p "Those mice are destroyed.") 121 | (npf= np :is "A mouse is here.") 122 | (npf= np :ip "Some mice are here.") 123 | (npf= np :p "Your mouse is destroyed.") 124 | (npf= np :n "You won 2 mice.") 125 | 126 | ; Not automatically detectable. 127 | (setv np (NounPhrase "box" :plural "boxen")) 128 | (npf= np :ds "The box is destroyed.") 129 | (npf= np :dp "The boxen are destroyed.") 130 | (npf= np :is "A box is here.") 131 | (npf= np :ip "Some boxen are here.") 132 | (npf= np :p "Your box is destroyed.") 133 | (npf= np :n "You won 2 boxen.")) 134 | 135 | test-npformat-mass (fn [self] 136 | (setv np (NounPhrase "peanut butter" :mass T :unit "globs")) 137 | (npf= np :ds "The peanut butter is destroyed.") 138 | (npf= np :dp "The peanut butter is destroyed.") 139 | ; (npf= np :t1s "This peanut butter is destroyed.") 140 | ; (npf= np :t1p "This peanut butter is destroyed.") 141 | ; (npf= np :t2s "That peanut butter is destroyed.") 142 | ; (npf= np :t2p "That peanut butter is destroyed.") 143 | (npf= np :is "Some peanut butter is here.") 144 | (npf= np :ip "Some peanut butter is here.") 145 | (npf= np :p "Your peanut butter is destroyed.") 146 | (npf= np :n "You won 2 globs of peanut butter.")) 147 | 148 | test-npformat-pluraletantum (fn [self] 149 | (setv np (NounPhrase "pants" :always-plural T :unit "pairs")) 150 | (npf= np :ds "The pants are destroyed.") 151 | (npf= np :dp "The pants are destroyed.") 152 | (npf= np :is "Some pants are here.") 153 | (npf= np :ip "Some pants are here.") 154 | (npf= np :p "Your pants are destroyed.") 155 | (npf= np :n "You won 2 pairs of pants.") 156 | 157 | ; Nouns that are nominally count nouns, but are always 158 | ; regarded in quantity by the game, may be treated the same 159 | ; as real plurale tantum. 160 | (setv np (NounPhrase "sunflower seeds" :always-plural T :unit "handfuls")) 161 | (npf= np :ds "The sunflower seeds are destroyed.") 162 | (npf= np :dp "The sunflower seeds are destroyed.") 163 | (npf= np :is "Some sunflower seeds are here.") 164 | (npf= np :ip "Some sunflower seeds are here.") 165 | (npf= np :p "Your sunflower seeds are destroyed.") 166 | (npf= np :n "You won 2 handfuls of sunflower seeds.")) 167 | 168 | test-npformat-proper-singular (fn [self] 169 | (setv np (NounPhrase "Stormbringer" :bare-proper T)) 170 | (npf= np :ds "Stormbringer is destroyed.") 171 | (npf= np :dp "The Stormbringers are destroyed.") 172 | ; (npf= np :t1s "Stormbringer is destroyed.") 173 | ; (npf= np :t1p "These Stormbringers are destroyed.") 174 | ; (npf= np :t2s "Stormbringer is destroyed.") 175 | ; (npf= np :t2p "Those Stormbringers are destroyed.") 176 | (npf= np :is "Stormbringer is here.") 177 | (npf= np :ip "Some Stormbringers are here.") 178 | (npf= np :p "Stormbringer is destroyed.") 179 | (npf= np :n "You won 2 Stormbringers.")) 180 | 181 | test-npformat-theproper-singular (fn [self] 182 | (setv np (NounPhrase "Black Scythe" :the-proper T)) 183 | (npf= np :ds "The Black Scythe is destroyed.") 184 | (npf= np :dp "The Black Scythes are destroyed.") 185 | ; (npf= np :t1s "The Black Scythe is destroyed.") 186 | ; (npf= np :t1p "The Black Scythes are destroyed.") 187 | ; (npf= np :t2s "The Black Scythe is destroyed.") 188 | ; (npf= np :t2p "The Black Scythes are destroyed.") 189 | (npf= np :is "The Black Scythe is here.") 190 | (npf= np :ip "Some Black Scythes are here.") 191 | (npf= np :p "The Black Scythe is destroyed.") 192 | (npf= np :n "You won 2 Black Scythes.")) 193 | 194 | ; English grammar does not seem to allow a plural direct 195 | ; equivalent of "Stormbringer". Here, "Santa's" is a determiner, 196 | ; not just part of a name. "Your Santa's Pants" is arguably not 197 | ; grammatical. 198 | ; "Santa's Pants are destroyed.", etc. 199 | 200 | test-npformat-theproper-plural (fn [self] 201 | (setv np (NounPhrase "Eyes of the Overworld" :the-proper T :always-plural T :unit "pairs")) 202 | (npf= np :ds "The Eyes of the Overworld are destroyed.") 203 | (npf= np :dp "The pairs of the Eyes of the Overworld are destroyed.") 204 | ; (npf= np :t1s "The Eyes of the Overworld are destroyed.") 205 | ; (npf= np :t1p "These pairs of the Eyes of the Overworld are destroyed.") 206 | ; (npf= np :t2s "The Eyes of the Overworld are destroyed.") 207 | ; (npf= np :t2p "Those pairs of the Eyes of the Overworld are destroyed.") 208 | (npf= np :is "The Eyes of the Overworld are here.") 209 | (npf= np :ip "Some pairs of the Eyes of the Overworld are here.") 210 | (npf= np :p "The Eyes of the Overworld are destroyed.") 211 | (npf= np :n "You won 2 pairs of the Eyes of the Overworld.")) 212 | 213 | test-npformat-stem-with-unit (fn [self] 214 | (defn f [x y] (a= .format "{:p-the}" (NounPhrase x) (+ "the " y))) 215 | (f "slice of cake" "slices of cake") 216 | (f "mug of coffee" "mugs of coffee") 217 | (f "can of Coke" "cans of Coke") 218 | (f "box of Froot Loops" "boxes of Froot Loops"))]) 219 | 220 | (when (= __name__ "__main__") 221 | (setv suite (.loadTestsFromTestCase (unittest.TestLoader) C)) 222 | (.run (unittest.TextTestRunner) suite)) 223 | -------------------------------------------------------------------------------- /tools/build-bundles.hy: -------------------------------------------------------------------------------- 1 | (import 2 | os 3 | importlib 4 | [subprocess [check-call check-output]] 5 | datetime) 6 | 7 | (unless (os.path.exists "build") 8 | (os.mkdir "build")) 9 | (setv target-posix "build/roguetv-posix.tar.gz") 10 | (setv target-windows "build/roguetv-windows.zip") 11 | 12 | ; Create the VERSION files. 13 | (setv commit (.rstrip (.decode 14 | (check-output ["git" "log" "-1" "--format=%H"]) "ASCII"))) 15 | (setv timestamp (.isoformat (.replace (datetime.datetime.utcnow) :microsecond 0))) 16 | (for [platform ["posix" "windows"]] 17 | (with [o (open (.format "bundle-{}/VERSION" platform) "w")] (o.write (+ 18 | platform "\n" 19 | "Git commit " commit "\n" 20 | "Packaged " timestamp "\n")))) 21 | 22 | ; Refresh symbolic links. 23 | (for [mname ["hy" "appdirs" "inflect" "jsonpickle" "pypaths" "rply" "clint"]] 24 | (setv m (importlib.import-module mname)) 25 | (setv source m.__file__) 26 | (setv dest (os.path.join "bundle-posix/lib" mname)) 27 | (if (= (os.path.basename source) "__init__.py") 28 | ; This module has a directory tree of files. 29 | (setv source (os.path.dirname source)) 30 | ; Otherwise, it's just a single file. 31 | (+= dest ".py")) 32 | (when (os.path.lexists dest) 33 | (os.remove dest)) 34 | (os.symlink source dest) 35 | (unless (os.path.exists dest) 36 | (exit (+ "Broken symbolic link?: " dest)))) 37 | 38 | (check-call ["tar" 39 | "-h" "--posix" "--numeric-owner" 40 | "--exclude" "__pycache__" 41 | "--transform" "s!^[^/]+!roguetv-posix!x" 42 | "-zcf" target-posix "bundle-posix"]) 43 | 44 | (check-call ["zip" 45 | "-r" "--quiet" 46 | target-windows "bundle-windows"]) 47 | -------------------------------------------------------------------------------- /tools/check-module-order.hy: -------------------------------------------------------------------------------- 1 | ; This script checks that the roguetv.* modules obey a standard 2 | ; order in which to import modules. 3 | ; 4 | ; While the order in which modules are listed in (import ...) 5 | ; isn't very important, the module load order potentially is, due 6 | ; to the perils of recursive imports. Specifying and enforcing a 7 | ; canonical load order (and import order) helps to clarify which 8 | ; modules are allowed to import from which others. 9 | 10 | (require [kodhy.macros [lc amap filt]]) 11 | (import os.path) 12 | 13 | (setv modules (with [o (open "module-order.txt")] 14 | (filt it (.split (.read o) "\n")))) 15 | 16 | (for [module (filt (.startswith it "roguetv.") modules)] 17 | 18 | (setv import-form (do 19 | (setv fname (.replace (.replace module "." "/") "-" "_")) 20 | (when (and (os.path.exists fname) (os.path.isdir fname)) 21 | (continue)) 22 | (when (os.path.exists (+ fname ".py")) 23 | (continue)) 24 | (+= fname ".hy") 25 | (setv form None) 26 | (with [o (open fname)] 27 | (try 28 | (while True 29 | (setv form (read o)) 30 | (when (= (first form) 'import) 31 | (break))) 32 | (except [EOFError]))) 33 | form)) 34 | 35 | (unless import-form (continue)) 36 | 37 | (setv imports-from 38 | (filt (in it modules) 39 | (amap (if (instance? list it) (first it) it) 40 | (cut import-form 1)))) 41 | (setv ix (amap (.index modules it) imports-from)) 42 | (setv sorted? (all (lc [[a b] (zip ix (rest ix))] (< a b)))) 43 | (unless sorted? 44 | (print (.format "{} import order - WRONG: {}" module (list (zip imports-from ix))))) 45 | (setv backwards-deps? (any (amap (>= it (.index modules module)) ix))) 46 | (when backwards-deps? 47 | (print module "no backwards deps - WRONG"))) 48 | -------------------------------------------------------------------------------- /tools/chest-probs.hy: -------------------------------------------------------------------------------- 1 | ; Computes the proportion of chests that are nonempty on each level. 2 | 3 | (import 4 | [roguetv.globals :as G] 5 | [roguetv.mapgen [*]]) 6 | 7 | (setv reps 1000) 8 | 9 | (setv full-chests 0) 10 | (setv empty-chests 0) 11 | 12 | (for [dl (range (inc G.max-dungeon-level))] 13 | (for [_ (range reps)] 14 | (for [[in-chest? _] (select-items dl)] 15 | (when in-chest? 16 | (+= full-chests 1))) 17 | (for [o (select-obstacles dl)] 18 | (when (is o O-EmptyChest) 19 | (+= empty-chests 1)))) 20 | (print (.format "{:2d} {:.2f}" 21 | (inc dl) 22 | (/ full-chests (+ full-chests empty-chests))))) 23 | -------------------------------------------------------------------------------- /tools/generation-counts.hy: -------------------------------------------------------------------------------- 1 | ; Get information about the probabilitiy distribution of the 2 | ; number of obstacles, items, and benefits generated per level. 3 | ; The output is tables of quantiles per dungeon level/ 4 | 5 | (require [kodhy.macros [rmap replicate]]) 6 | 7 | (import 8 | roguetv.mapgen 9 | [pandas :as pd]) 10 | 11 | (setv n 100000) 12 | (setv qs [.01 .1 .2 .3 .4 .5 .6 .7 .8 .9 .99]) 13 | 14 | (for [x ["obstacles" "items" "benefits"]] 15 | (print x) 16 | (setv d (pd.DataFrame (rmap [dl [0 9 19]] 17 | (setv ps (.copy (get roguetv.mapgen.gen-count-params x))) 18 | (setv (get ps "dl") dl) 19 | (setv v (pd.Series (replicate n 20 | (apply roguetv.mapgen.gen-count [] ps)))) 21 | (setv v (.quantile v qs)) 22 | (setv v.name (inc dl)) 23 | v))) 24 | (setv d.columns qs) 25 | (print d)) 26 | -------------------------------------------------------------------------------- /tools/generation-probs.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [λ amap filt ecase]]) 2 | 3 | (import 4 | sys 5 | [itertools [groupby]] 6 | [random [randint]] 7 | [roguetv.globals :as G] 8 | [roguetv.util [*]] 9 | roguetv.item 10 | ; To ensure G.itypes is filled. 11 | [roguetv.mapgen [Obstacle select-items select-obstacles select-benefits]] 12 | [kodhy.util [T F shift weighted-choice]]) 13 | 14 | (shift sys.argv) 15 | (setv mode (shift sys.argv)) 16 | (setv dl (shift sys.argv)) 17 | (setv chest? (and sys.argv (shift sys.argv))) 18 | 19 | (setv dl (int dl)) 20 | 21 | (ecase mode 22 | ["probs" 23 | (for [ition [0 1]] 24 | (setv l (sorted :reverse T :key (λ (, (first it) (repr (second it)))) 25 | (amap (, (it.generation-weight dl chest?) it) 26 | (filt (!= it.rarity :nongen) 27 | (get [Obstacle.types (.values G.itypes)] ition))))) 28 | (setv total (sum (map first l))) 29 | (for [[w c] l] 30 | (print (.format "{:1.03f} {.__name__}" (/ w total) c))) 31 | (print))] 32 | ["sample" 33 | (for [[s f] [["Obstacles" select-obstacles] ["Benefits" select-benefits]]] 34 | (print "---" s "---") 35 | (for [[_ l] (groupby (sorted (f dl) :key str))] 36 | (setv l (list l)) 37 | (print (len l) "×" (. (first l) __name__))) 38 | (print)) 39 | (print "--- Items ---") 40 | (for [[in-chest? itype] (sorted (select-items dl) :key str)] 41 | (print itype.tid (if in-chest? "(chest)" "")))]) 42 | -------------------------------------------------------------------------------- /tools/run-posix.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | if [ "$TERM" = screen ] ; then 4 | TERM=screen-256color 5 | else 6 | TERM=xterm-256color 7 | fi 8 | 9 | export ROGUETV_BUNDLE_INFO="$(cat VERSION)" 10 | cd lib 11 | exec python3 -c 'import hy, roguetv_run' "$@" 12 | -------------------------------------------------------------------------------- /tools/run-windows.bat: -------------------------------------------------------------------------------- 1 | start cygwin64/bin/mintty -e cygwin64/bin/bash -c 'PATH=$(pwd)/cygwin64/bin; exec bash' 2 | -------------------------------------------------------------------------------- /tools/run-windows.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | TERM=xterm-256color 4 | export LANG=en_US.UTF-8 5 | export ROGUETV_BUNDLE_INFO="$(cat VERSION)" 6 | cd lib 7 | exec python3.4m.exe -c 'import hy, roguetv_run' "$@" 8 | -------------------------------------------------------------------------------- /tools/tabulate-items.hy: -------------------------------------------------------------------------------- 1 | (require [kodhy.macros [afind-or λ ecase]]) 2 | 3 | (import 4 | sys 5 | re 6 | subprocess 7 | [kodhy.util [T F keyword->str]] 8 | [roguetv.globals :as G] 9 | roguetv.item 10 | [roguetv.item.gadget [Gadget]] 11 | [roguetv.item.soda [Soda]] 12 | [roguetv.item.clothing [Clothing]] 13 | [roguetv.item.burden [Burden]]) 14 | 15 | (setv mode (second sys.argv)) 16 | 17 | (defn colorize256 [fg bg text] 18 | (when (none? fg) 19 | (setv fg G.fg-color)) 20 | (when (none? bg) 21 | (setv bg (G.pick-bg-color fg))) 22 | (.format "\x1b[38;5;{};48;5;{}m{}\x1b[0m" 23 | (get G.color-numbers fg) (get G.color-numbers bg) text)) 24 | 25 | (setv termcols (int (subprocess.check-output ["tput" "cols"]))) 26 | 27 | (defn show-items [title predicate] 28 | (setv items (list (filter predicate (.values G.itypes)))) 29 | (print (.format "{} ({})" title (len items))) 30 | (print "--------------------------------------------------") 31 | (for [item (sorted items :key (λ (, (- (it.generation-weight 0)) (- (or it.level-hi 9999)) it.price it.tid)))] 32 | (setv s (.format "{:20} {:3} {:.3} {:2} {:2} � {}" 33 | item.tid 34 | item.price 35 | (keyword->str item.rarity) 36 | (if (= item.level-lo 0) "" (+ 1 item.level-lo)) 37 | (if (none? item.level-hi) "" (+ 1 item.level-hi)) 38 | item.name.stem)) 39 | (setv s (cut s 0 termcols)) 40 | (setv s (.replace s "�" 41 | (colorize256 item.color-fg item.color-bg item.char))) 42 | (print s)) 43 | (print)) 44 | 45 | (ecase mode 46 | ["all" 47 | (show-items "All items" (λ T))] 48 | ["category" 49 | (setv cs [Soda Gadget Clothing Burden]) 50 | (for [c cs] 51 | (show-items c.__name__ (λ (issubclass it c)))) 52 | (show-items "Other" (fn [x] (not (afind-or (issubclass x it) cs))))]) 53 | --------------------------------------------------------------------------------