|
@@ -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)"
|