Browse Source

Handle non-contiguous ranges

Getty Ritter 5 years ago
parent
commit
d996f2317f
1 changed files with 18 additions and 12 deletions
  1. 18 12
      src/Types.hs

+ 18 - 12
src/Types.hs

@@ -4,6 +4,7 @@ module Types where
 
 import qualified Control.Exception as Exn
 import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
 import qualified Data.Text as Text
 import qualified System.Random as Rand
 
@@ -13,6 +14,11 @@ type Roll = Int
 data Range = Range { rFrom :: Roll, rTo :: Roll }
   deriving (Eq, Show)
 
+-- needed to handle d66 tables
+rangeMap :: [Range] -> [Int]
+rangeMap = Set.toList . foldr (Set.union . toSet) Set.empty
+  where toSet (Range x y) = Set.fromList [x..y]
+
 type TableMap = Map.Map TableName Table
 
 data Table = Table
@@ -92,13 +98,12 @@ computeResult ctx (Result msgs) = do
   vs <- mapM (computeFragments ctx) msgs
   pure (concatValues ctx vs)
 
-tableDie :: Table -> Int
-tableDie t = maximum [ x | (Range _ x, _) <- tableChoices t ]
-
 rollTable :: TableMap -> Table -> IO Value
 rollTable tables t = do
-  roll <- Rand.randomRIO (1, tableDie t)
-  let ctx = Context
+  let rmap = rangeMap (map fst (tableChoices t))
+  rollIdx <- Rand.randomRIO (0, length rmap - 1)
+  let roll = rmap !! rollIdx
+      ctx = Context
         { ctxMap = tables
         , ctxRoll = roll
         , ctxSelf = tableName t
@@ -108,10 +113,11 @@ rollTable tables t = do
        , roll >= rFrom range && roll <= rTo range
        ] of
     [choice] -> stripValue <$> computeResult ctx choice
-    _ -> error $ unwords
-           [ "bad table "
-           , Text.unpack (tableName t)
-           , "(roll of"
-           , show roll
-           , "has no matching result)"
-           ]
+    [] -> error $ unwords
+          [ "bad table "
+          , Text.unpack (tableName t)
+          , "(roll of"
+          , show roll
+          , "has no matching result)"
+          ]
+    _ -> error "ambiguous result (TODO)"