Handle non-contiguous ranges
Getty Ritter
6 years ago
| 4 | 4 | |
| 5 | 5 | import qualified Control.Exception as Exn |
| 6 | 6 | import qualified Data.Map.Strict as Map |
| 7 | import qualified Data.Set as Set | |
| 7 | 8 | import qualified Data.Text as Text |
| 8 | 9 | import qualified System.Random as Rand |
| 9 | 10 | |
| 12 | 13 | |
| 13 | 14 | data Range = Range { rFrom :: Roll, rTo :: Roll } |
| 14 | 15 | deriving (Eq, Show) |
| 16 | ||
| 17 | -- needed to handle d66 tables | |
| 18 | rangeMap :: [Range] -> [Int] | |
| 19 | rangeMap = Set.toList . foldr (Set.union . toSet) Set.empty | |
| 20 | where toSet (Range x y) = Set.fromList [x..y] | |
| 15 | 21 | |
| 16 | 22 | type TableMap = Map.Map TableName Table |
| 17 | 23 | |
| 92 | 98 | vs <- mapM (computeFragments ctx) msgs |
| 93 | 99 | pure (concatValues ctx vs) |
| 94 | 100 | |
| 95 | tableDie :: Table -> Int | |
| 96 | tableDie t = maximum [ x | (Range _ x, _) <- tableChoices t ] | |
| 97 | ||
| 98 | 101 | rollTable :: TableMap -> Table -> IO Value |
| 99 | 102 | rollTable tables t = do |
| 100 | roll <- Rand.randomRIO (1, tableDie t) | |
| 101 | let ctx = Context | |
| 103 | let rmap = rangeMap (map fst (tableChoices t)) | |
| 104 | rollIdx <- Rand.randomRIO (0, length rmap - 1) | |
| 105 | let roll = rmap !! rollIdx | |
| 106 | ctx = Context | |
| 102 | 107 | { ctxMap = tables |
| 103 | 108 | , ctxRoll = roll |
| 104 | 109 | , ctxSelf = tableName t |
| 108 | 113 | , roll >= rFrom range && roll <= rTo range |
| 109 | 114 | ] of |
| 110 | 115 | [choice] -> stripValue <$> computeResult ctx choice |
| 111 | _ -> error $ unwords | |
| 112 | [ "bad table " | |
| 113 | , Text.unpack (tableName t) | |
| 114 | , "(roll of" | |
| 115 | , show roll | |
| 116 | , "has no matching result)" | |
| 117 |
|
|
| 116 | [] -> error $ unwords | |
| 117 | [ "bad table " | |
| 118 | , Text.unpack (tableName t) | |
| 119 | , "(roll of" | |
| 120 | , show roll | |
| 121 | , "has no matching result)" | |
| 122 | ] | |
| 123 | _ -> error "ambiguous result (TODO)" | |