gdritter repos potrero / 96d98f9
wonky but working first pass at a table-rolling application Getty Ritter 6 years ago
6 changed file(s) with 338 addition(s) and 0 deletion(s). Collapse all Expand all
+20
-0
.gitignore less more
1 dist
2 dist-*
3 *~
4 cabal-dev
5 *.o
6 *.hi
7 *.chi
8 *.chs.h
9 *.dyn_o
10 *.dyn_hi
11 .hpc
12 .hsenv
13 .cabal-sandbox/
14 cabal.sandbox.config
15 *.prof
16 *.aux
17 *.hp
18 *.eventlog
19 cabal.project.local
20 .ghc.environment.*
+124
-0
perilous-wilds.txt less more
1 dungeon
2 size
3 1-3: small (2 themes, 6 areas)
4 4-9: medium (3 themes, 12 areas)
5 10-11: large (4 themes, 16 aras)
6 12: huge (5 themes, 24 areas)
7 discovery
8 1: unthemed, common, empty
9 2: unthemed, common, danger
10 3-4: unthemed, common, danger + discovery
11 5-6: unthemed, common, discovery
12
13 7: themed, common, danger
14 8: themed, common, danger + discovery
15 9: themed, common, discovery
16 10: themed, unique, danger
17 11: themed, unique, danger + discovery
18 12: themed, unique, discovery
19 ruination
20 1: arcane disaster
21 2: damnation/curse
22 3-4: earthquate/fire/flood
23 5-6: plague/famine/drought
24 7-8: overrun by monsters
25 9-10: war/invasion
26 11: depleted resources
27 12: better prospects elsewhere
28
29 foundation
30 builder
31 1: aliens/precursors
32 2: demigod/demon
33 3-4: natural (caves etc.)
34 5: religious order/cult
35 6-7: humanoid
36 8-9: dwarves/gnomes
37 10: elves
38 11: wizard/madman
39 12: monarch/warlord
40 function
41 1: source/portal
42 2: mine
43 3-4: tomb/crypt
44 5: prison
45 6-7: lair/den/hideout
46 8-9: stronghold/sanctuary
47 10: shrine/temple/oracle
48 11: archive/library
49 12: unknown/mystery
50
51 theme
52 1-5: @dungeon/theme/mundane
53 6-9: @dungeon/theme/unusual
54 10-12: @dungeon/theme/extraordinary
55 mundane
56 1: rot/decay
57 2: torture/agony
58 3: madness
59 4: all is lost
60 5: noble sacrifice
61 6: savage fury
62 7: survival
63 8: criminal activity
64 9: secrets/treachery
65 10: tricks and traps
66 11: invasion/infestation
67 12: factions at war
68 unusual
69 1: creation/invention
70 2: element
71 3: knowledge/learning
72 4: growth/expansion
73 5: deepening mystery
74 6: transformation/change
75 7: chaos and destruction
76 8: shadowy forces
77 9: forbidden knowledge
78 10: poison/disease
79 11: corruption/blight
80 12: impending disaster
81 extraordinary
82 1: scheming evil
83 2: divination/scrying
84 3: blasphemy
85 4: arcane research
86 5: occult forces
87 6: an ancient curse
88 7: mutation
89 8: the unquiet dead
90 9: bottomless hunger
91 10: incredible power
92 11: unspeakable horrors
93 12: holy war
94
95 discovery
96 1-3: @dungeon/discovery/dressing
97 dressing
98 1: junk/debris
99 2: tracks/marks
100 3: signs of battle
101 4: writing/carving
102 5: warning
103 6: dead creature
104 7: bones/remains
105 8: book/scroll/map
106 9: broken door/wall
107 10: breeze/wind/smell
108 11: lichen/moss/fungus
109 12: @details/oddity
110
111 details
112 oddity
113 1: weird color/smell/sound
114 2: geometric
115 3: web/network/system
116 4: crystalline/glass-like
117 5: fungal
118 6: gaseous/smokey
119 7: mirage/illusion
120 8: volcanic/explosive
121 9: magnetic/repellant
122 10: devoid of life
123 11: unexpectedly alive
124 12: roll twice
+21
-0
potrero.cabal less more
1 name: potrero
2 version: 0.1.0.0
3 license: BSD3
4 author: Getty Ritter <gettylefou@gmail.com>
5 maintainer: Getty Ritter <gettylefou@gmail.com>
6 copyright: @2018 Getty Ritter
7 build-type: Simple
8 cabal-version: >=1.14
9
10 executable potrero
11 hs-source-dirs: src
12 main-is: Main.hs
13 other-modules: Types
14 Parser
15 default-language: Haskell2010
16 ghc-options: -Wall
17 build-depends: base >=4.7 && <5
18 , containers
19 , random
20 , readline
21 , text
+58
-0
src/Main.hs less more
1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE OverloadedLists #-}
3 {-# LANGUAGE TypeFamilies #-}
4
5 module Main where
6
7 import qualified Control.Monad as M
8 import qualified Data.IORef as IO
9 import qualified Data.Map.Strict as Map
10 import Data.Monoid ((<>))
11 import qualified Data.Text as Text
12 import qualified Data.Text.IO as Text
13 import qualified System.Console.Readline as Readline
14 import qualified System.Exit as Exit
15
16 import qualified Parser
17 import qualified Types
18
19 readMap :: FilePath -> IO Types.TableMap
20 readMap path = do
21 cs <- Text.readFile path
22 pure $ Map.fromList
23 [ (Types.tableName t, t)
24 | t <- Parser.parseTable cs
25 ]
26
27 main :: IO ()
28 main = do
29 tablesRef <- IO.newIORef =<< readMap "tables.txt"
30 Readline.setCompletionEntryFunction $ Just $ \ rs -> do
31 tables <- IO.readIORef tablesRef
32 pure [ Text.unpack k
33 | k <- Map.keys tables
34 , Text.pack rs `Text.isPrefixOf` k
35 ]
36 M.forever $ do
37 input <- Readline.readline "\x1b[31m--> \x1b[39m"
38 case input of
39 Nothing -> do
40 putStrLn "farewell"
41 Exit.exitSuccess
42 Just "" -> pure ()
43 Just ":l" -> do
44 tables <- IO.readIORef tablesRef
45 Text.putStrLn "Available tables: "
46 Text.putStrLn (" " <> Text.unwords (Map.keys tables))
47 IO.writeIORef tablesRef =<< readMap "tables.txt"
48 Just ":r" ->
49 IO.writeIORef tablesRef =<< readMap "tables.txt"
50 Just choice -> do
51 tables <- IO.readIORef tablesRef
52 let names = Text.unwords (Map.keys tables)
53 Readline.addHistory choice
54 case Map.lookup (Text.strip (Text.pack choice)) tables of
55 Nothing -> do
56 Text.putStrLn ("table not found: " <> Text.pack (show choice))
57 Text.putStrLn (" valid tables include: " <> names)
58 Just t -> Types.rollTable tables t
+62
-0
src/Parser.hs less more
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Parser where
4
5 import Data.Char as Char
6 import qualified Data.Text as Text
7
8 import Types
9
10 data LineType
11 = TableDecl Int Text.Text
12 | TableEntry Range Result
13 deriving (Eq, Show)
14
15 indentAmount :: Text.Text -> Int
16 indentAmount = Text.length . Text.takeWhile Char.isSpace
17
18 parseRange :: Text.Text -> Range
19 parseRange t
20 | Text.all Char.isNumber (Text.strip t) =
21 let n = read (Text.unpack t) in Range n n
22 | otherwise =
23 let (x, y) = Text.breakOn "-" (Text.strip t)
24 n = read (Text.unpack x)
25 m = read (Text.unpack (Text.tail y))
26 in Range n m
27
28 parseResult :: Text.Text -> Result
29 parseResult t
30 | "@" `Text.isPrefixOf` Text.strip t =
31 ResultRoll (Text.tail (Text.strip t))
32 | otherwise =
33 ResultText (Text.strip t)
34
35 parseLines :: [Text.Text] -> [LineType]
36 parseLines = go
37 where
38 go [] = []
39 go (t:ts)
40 | Text.all Char.isSpace t = go ts
41 | Text.any (== ':') t =
42 let (rangeTxt, message) = Text.breakOn ":" t
43 range = parseRange rangeTxt
44 msg = parseResult (Text.tail message)
45 in TableEntry range msg : go ts
46 | otherwise =
47 TableDecl (indentAmount t) (Text.strip t) : go ts
48
49 parseTable :: Text.Text -> [Table]
50 parseTable = parseTop [] . parseLines . Text.lines
51 where
52 parseTop _ [] = []
53 parseTop ctx (TableDecl n name:xs) =
54 parseTop ((n, name) : [ c | c <- ctx, fst c < n]) xs
55 parseTop ctx (TableEntry r m:xs) =
56 let (table, rest) = gatherEntries ctx xs [(r, m)]
57 in table : parseTop ctx rest
58 gatherEntries ctx (TableEntry r m:xs) es =
59 gatherEntries ctx xs ((r, m) : es)
60 gatherEntries ctx rs es =
61 let name = Text.intercalate "/" (reverse (map snd ctx))
62 in (Table name (reverse es), rs)
+53
-0
src/Types.hs less more
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Types where
4
5 import qualified Data.Map.Strict as Map
6 import qualified Data.Text as Text
7 import qualified Data.Text.IO as Text
8 import qualified System.Random as Rand
9
10 data Range = Range { rFrom :: Int, rTo :: Int }
11 deriving (Eq, Show)
12
13 type TableMap = Map.Map Text.Text Table
14
15 data Table = Table
16 { tableName :: Text.Text
17 , tableChoices :: [(Range, Result)]
18 } deriving (Eq, Show)
19
20 data Result
21 = ResultText Text.Text
22 | ResultRoll Text.Text
23 deriving (Eq, Show)
24
25 computeResult :: Int -> TableMap -> Result -> IO ()
26 computeResult r _ (ResultText msg) = do
27 Text.putStr ("\x1b[36m" <> Text.pack (show r) <> ":\x1b[39m ")
28 Text.putStrLn msg
29 computeResult r ts (ResultRoll name)
30 | Just t <- Map.lookup name ts = do
31 Text.putStr ("\x1b[36m" <> Text.pack (show r))
32 Text.putStrLn (": (roll " <> name <> ")\x1b[39m")
33 rollTable ts t
34 | otherwise = Text.putStrLn ("error: no such table: " <> name)
35
36 tableDie :: Table -> Int
37 tableDie t = maximum [ x | (Range _ x, _) <- tableChoices t ]
38
39 rollTable :: TableMap -> Table -> IO ()
40 rollTable tables t = do
41 roll <- Rand.randomRIO (1, tableDie t)
42 case [ result
43 | (range, result) <- tableChoices t
44 , roll >= rFrom range && roll <= rTo range
45 ] of
46 [choice] -> computeResult roll tables choice
47 _ -> Text.putStrLn $ Text.unwords
48 [ "bad table "
49 , tableName t
50 , "(roll of"
51 , Text.pack (show roll)
52 , "has no matching result)"
53 ]